langhash.c

Go to the documentation of this file.
00001 
00002 /*  $Id: langhash.c 1316 2006-04-20 20:06:19Z andreradke $    */
00003 
00004 /******************************************************************************
00005 
00006     UserLand Frontier(tm) -- High performance Web content management,
00007     object database, system-level and Internet scripting environment,
00008     including source code editing and debugging.
00009 
00010     Copyright (C) 1992-2004 UserLand Software, Inc.
00011 
00012     This program is free software; you can redistribute it and/or modify
00013     it under the terms of the GNU General Public License as published by
00014     the Free Software Foundation; either version 2 of the License, or
00015     (at your option) any later version.
00016 
00017     This program is distributed in the hope that it will be useful,
00018     but WITHOUT ANY WARRANTY; without even the implied warranty of
00019     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
00020     GNU General Public License for more details.
00021 
00022     You should have received a copy of the GNU General Public License
00023     along with this program; if not, write to the Free Software
00024     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
00025 
00026 ******************************************************************************/
00027 
00028 #include "frontier.h"
00029 #include "standard.h"
00030 
00031 #include "error.h"
00032 #include "memory.h"
00033 #include "strings.h"
00034 #include "font.h"
00035 #include "ops.h"
00036 #include "quickdraw.h"
00037 #include "resources.h"
00038 #include "lang.h"
00039 #include "langinternal.h"
00040 #include "langexternal.h"
00041 #include "langipc.h"
00042 #include "langsystem7.h"
00043 #include "tablestructure.h"
00044 #include "tableverbs.h"
00045 #include "oplist.h"
00046 #include "timedate.h"
00047 #include "byteorder.h"  /* 2006-04-08 aradke: endianness conversion macros */
00048 
00049 #if TARGET_API_MAC_CARBON == 1 /*PBS 03/14/02: AE OS X fix.*/
00050     #include "aeutils.h" /*PBS 03/14/02: AE OS X fix.*/
00051 #endif
00052 
00053 typedef struct tydisksymbolrecord {
00054     
00055     long ixkey; /*in the string handle, where is this symbol's name?*/
00056     
00057     unsigned char valuetype; /*copied from the symbol's value record*/
00058     
00059     unsigned char version;
00060     
00061     tyvaluedata data; /*if a string, this stores an index into the string handle*/
00062     } tydisksymbolrecord, *ptrdisksymbolrecord, **hdldisksymbolrecord;
00063 
00064 typedef struct tyOLD42disksymbolrecord {
00065     
00066     long ixkey; /*in the string handle, where is this symbol's name?*/
00067     
00068     unsigned char valuetype; /*copied from the symbol's value record*/
00069     
00070     unsigned char version : 4;
00071     
00072     unsigned char unused : 3;
00073     
00074     unsigned char flsorted : 1; /*were these records packed in sort order?*/
00075     
00076     tyvaluedata data; /*if a string, this stores an index into the string handle*/
00077     } tyOLD42disksymbolrecord, *ptrOLD42disksymbolrecord, **hdlOLD42disksymbolrecord;
00078 
00079 
00080 // 5.0.1: bumped version number so we can clear uninitialized flags
00081 #define tablediskversion 0x03
00082 
00083 
00084 typedef struct tydisktablerecord { /*new in 5.0, a header for each table*/
00085     
00086     short version; /*in the string handle, where is this symbol's name?*/
00087     
00088     short sortorder;
00089     
00090     unsigned long timecreated, timelastsave; /*number of seconds since 1/1/04*/
00091     
00092     long flags;
00093     } tydisktablerecord, *ptrdisktablerecord, **hdldisktablerecord;
00094 
00095 
00096 typedef enum tylinetableitemflags {
00097 
00098 #ifdef MACVERSION
00099     flxml = 0x8000
00100 #endif
00101 
00102 #ifdef WIN95VERSION
00103     flxml = 0x0080
00104 #endif
00105     } tylinetableitemflags;
00106 
00107 #define maxinlinescalarsize 1023
00108 #define diskvalsizeflag     (-1)
00109 
00110 typedef struct tydiskvaluerecord {      /*4.0.1b1 dmb*/
00111     
00112     long sizeflag;  /*always -1*/
00113     
00114     dbaddress adr;  /*addres of actual scalar value*/
00115     } tydiskvaluerecord;
00116 
00117 
00118 
00119 hdlhashtable currenthashtable = nil;
00120 
00121 hdltablestack hashtablestack = nil;
00122 
00123 boolean fllanghashassignprotect = false;
00124 
00125 boolean fllangexternalvalueprotect = false; /*4.1b4 dmb: new global, disable protection*/
00126 
00127 
00128 static boolean flunpackingtable = 0;
00129 
00130 //static Handle h1; /*global for packing and unpacking routines -- holds the binary info*/
00131 
00132 //static Handle h2; /*global for packing and unpacking routines -- holds the text info*/
00133 
00134 static hdlhashnode hnewnode; /*global for hashinsertaddress*/
00135 
00136 static boolean flexternalmemorypack = false;
00137 
00138 static hdldatabaserecord hexternalpackdatabase;
00139 
00140 
00141 
00142 static hdlhashtable hfirstfreetable = nil; /*private free list for hash tables*/
00143 
00144 
00145 #ifdef fldebug
00146 
00147 static long cthashtablesallocated = 0;
00148 
00149 #endif
00150 
00151 
00152 #ifdef fltracklocaladdresses
00153 
00154     #ifdef fldebug
00155 
00156     static long ctrefnodesadded = 0;
00157 
00158     static long ctrefnodesremoved = 0;
00159 
00160     static long ctrefnodesinvalidated = 0;
00161 
00162     #endif
00163 
00164 static void hashaddrefnode (hdlhashtable ht, hdlhashnode hn) {
00165     
00166     /*
00167     2003-05-21 AR: Insert the node at the beginning of the table's
00168     linked list of nodes that reference it.
00169     
00170     This is so that right before the table gets disposed, it can notify
00171     the nodes that the addresses they contain are about to become invalid.
00172     Not only are they pointing at an object that will no longer exist
00173     in the namespace, worse, the handle tacked onto the end of the address
00174     string will soon point at a block of memory that was already released!
00175     
00176     For now, we only keep track of nodes referencing a local table.
00177     
00178     Note that references to global tables can become invalid, too, if a
00179     database file is closed while an address pointing into it is part
00180     of some thread's stack of local variables.
00181     */
00182 
00183     assert (ht != nil);
00184     
00185     assert ((**ht).fllocaltable);
00186     
00187     assert (hn != nil);
00188     
00189     assert ((**hn).val.valuetype == addressvaluetype);
00190     
00191     assert ((**hn).refnodelink == nil);
00192     
00193     (**hn).refnodelink = (**ht).refnodes;
00194     
00195     (**ht).refnodes = hn;   
00196 
00197     #ifdef fldebug
00198         ++ctrefnodesadded;
00199     #endif
00200     } /*hashaddrefnode*/
00201 
00202 
00203 static void hashremoverefnode (hdlhashtable ht, hdlhashnode hn) {
00204 
00205     /*
00206     2003-05-21 AR: Complements hashaddrefnode.
00207     Remove the given node from the table's linked list.
00208     
00209     2003-06-14 AR: Commented out an over-eager assertion.
00210     */
00211 
00212     assert (ht != nil);
00213     
00214     assert ((**ht).fllocaltable);
00215     
00216     assert ((**ht).refnodes != nil);
00217     
00218     assert (hn != nil);
00219     
00220     // assert ((**hn).val.valuetype == addressvaluetype); /* this may no longer be true */
00221     
00222     if ((**ht).refnodes == hn) {
00223     
00224         (**ht).refnodes = (**hn).refnodelink;
00225     
00226         (**hn).refnodelink = nil;
00227         }
00228     else {
00229     
00230         hdlhashnode nomad = (**ht).refnodes;
00231     
00232         while ((**nomad).refnodelink != nil) {
00233 
00234             if ((**nomad).refnodelink == hn) {
00235             
00236                 (**nomad).refnodelink = (**hn).refnodelink;
00237                 
00238                 (**hn).refnodelink = nil;
00239                 
00240                 break;
00241                 } /*while*/
00242             
00243             nomad = (**nomad).refnodelink;
00244             }
00245         }
00246         
00247     assert ((**hn).refnodelink == nil); /*check that we found it*/
00248 
00249     #ifdef fldebug
00250         ++ctrefnodesremoved;
00251     #endif
00252     } /*hashremoverefnode*/
00253 
00254 
00255 void hashregisteraddressnode (hdlhashtable hparent, hdlhashnode hn) {
00256 
00257     /*
00258     2003-05-21 AR: Call me if the valuerecord of hn has just been
00259     assigned a new value. If it's an address of a local variable,
00260     we will register hn with the table that contains the local variable.
00261     
00262     When the table is about to be disposed, it can notify us of the fact
00263     that our address value is about to point to an invalid handle.
00264     
00265     Optimization: We don't have to register hn with the destination table
00266     if hn lives in a stack frame that will be disposed before (or at worst
00267     at the same time) as the destination table. For this to work properly,
00268     we have to make sure that if hn is unlinked and inserted into another
00269     table (or the same table), e.g. via copy&paste, we unregister and
00270     register hn again.
00271     
00272     Actually, the above should work but its probably not a useful optimization.
00273     Just check whether the table containing hn and the destination table are
00274     identical. This should already apply to a lot of cases.
00275     */
00276 
00277     assert ((**hn).reftable == nil);
00278 
00279     if ((**hn).val.valuetype == addressvaluetype && (**hn).reftable == nil) {
00280         
00281         hdlhashtable hdest;
00282         bigstring bsname;
00283         boolean fl;
00284         
00285         disablelangerror ();
00286         
00287         fl = getaddressvalue ((**hn).val, &hdest, bsname);
00288         
00289         enablelangerror ();
00290             
00291         if (!fl || (hdest == nil) || !(**hdest).fllocaltable)
00292             return;
00293         
00294         if (hparent == hdest) /*don't bother...*/
00295             return;
00296         
00297         /*
00298         if ((**hparent).fllocaltable) { //optimization?
00299 
00300             register hdlhashtable nomad = hparent;
00301             
00302             while ((**nomad).parenthashtable != nil) { //surface to stack frame
00303                 nomad = (**nomad).parenthashtable;
00304                 }
00305             
00306             while (nomad != nil && (**nomad).fllocaltable) { //walk chain and check whether hdest is in it
00307 
00308                 if (nomad == hdest)
00309                     return;
00310 
00311                 nomad = (**nomad).prevhashtable;
00312                 }
00313             }
00314         */
00315         
00316         hashaddrefnode (hdest, hn);
00317             
00318         (**hn).reftable = hdest;
00319         }
00320     } /*hashregisteraddressnode*/
00321 
00322 
00323 void hashunregisteraddressnode (hdlhashnode hn) {
00324 
00325     /*
00326     2003-05-21 AR: Call me if the valuerecord of hn has changed
00327     or if hn itself is about to be disposed.
00328     */
00329     
00330     if ((**hn).reftable != nil) {
00331 
00332         hashremoverefnode ((**hn).reftable, hn);
00333         
00334         (**hn).reftable = nil;
00335         }
00336     } /*hashunregisteraddressnode*/
00337 
00338 
00339 static void hashinvalidaterefnodes (hdlhashtable ht) {
00340     
00341     /*
00342     2003-05-21 AR: The hash table is about to be disposed, so notify
00343     all hash nodes containing an address that reference the table
00344     of the fact that they are about to become invalid.
00345     
00346     Call me from disposehashtable after it has disposed of its nodes.
00347     
00348     2003-05-23 AR: Set refnodes field to nil so we won't crash
00349     if we are called multiple times for the same table. Also, try
00350     to get the full path representation of the address, but this
00351     will only work if the table hasn't been removed from the
00352     namespace yet.
00353     */
00354 
00355     hdlhashnode hn, hnext;
00356     bigstring bspath;
00357         
00358     assert (ht != nil);
00359     
00360     hn = (**ht).refnodes; /*unlink list from table*/
00361     
00362     (**ht).refnodes = nil;
00363 
00364     disablelangerror (); /*must re-enable before we return*/
00365     
00366     while (hn != nil) {
00367         
00368         assert ((**hn).reftable == ht);
00369         assert ((**hn).val.valuetype == addressvaluetype);
00370         
00371         hnext = (**hn).refnodelink;
00372         
00373         /* unlink */
00374         
00375         (**hn).refnodelink = nil;
00376         
00377         (**hn).reftable = nil;
00378         
00379         /* nuke the htable handle tacked onto the item name */
00380         
00381         getaddresspath ((**hn).val, bspath);
00382         
00383         sethandlecontents (bspath, stringsize (bspath), (Handle) (**hn).val.data.addressvalue);
00384         
00385         #if fldebug
00386             ++ctrefnodesinvalidated;
00387         #endif
00388         
00389         /* advance */
00390         
00391         hn = hnext;
00392         } /*while*/
00393 
00394     enablelangerror ();
00395     
00396     } /*hashinvalidaterefnodes*/
00397 
00398 #endif /*fltracklocaladdresses*/
00399 
00400 
00401 boolean newhashtable (hdlhashtable *htable) {
00402     
00403     /*
00404     all fields are initialized to 0, no initialization code needed here.
00405     
00406     9/23/91 dmb: now look for magic table.  this allows a table to be stuffed 
00407     full of values in a location that is removed from and/or independent of 
00408     our caller.  in particular, langfunccall can populate a locals table without 
00409     adding it to the local chain; evaluatelist picks up the table indirectly by 
00410     pushing a local chain, which eventually tries to allocate a hash table.
00411     
00412     5.0d15 dmb: preserve new cttmpstack field. We're assuming that the reused 
00413     table pool is mostly for local tables that actually need temp stacks.
00414     */
00415     
00416     if (hmagictable != nil) {
00417         
00418         *htable = hmagictable;
00419         
00420         hmagictable = nil;
00421         
00422         return (true);
00423         }
00424     
00425     #ifdef fldebug
00426     
00427     ++cthashtablesallocated;
00428     
00429     #endif
00430     
00431     if (hfirstfreetable != nil) { /*let's reuse one that's been allocated*/
00432         
00433         hdlhashtable ht = hfirstfreetable;
00434         short ct;
00435         
00436         hfirstfreetable = (**hfirstfreetable).prevhashtable;
00437         
00438         ct = (**ht).cttmpstack;
00439         
00440         clearhandle ((Handle) ht);
00441         
00442         (**ht).cttmpstack = ct;
00443         
00444         *htable = ht;
00445         
00446         return (true);
00447         }
00448     
00449     if (!newclearhandle (sizeof (tyhashtable), (Handle *) htable))
00450         return (false);
00451     
00452     (***htable).timecreated = timenow ();
00453     
00454     return (true);
00455     } /*newhashtable*/
00456     
00457     
00458 short hashgetstackdepth (void) {
00459     
00460     /*
00461     if there are 12 tables in the current chain, return 12.
00462     */
00463     
00464     register hdlhashtable x = currenthashtable;
00465     register short ct = 0;
00466     
00467     while (x != nil) {
00468         
00469         ct++;
00470         
00471         x = (**x).prevhashtable;
00472         } /*while*/
00473         
00474     return (ct);
00475     } /*hashgetstackdepth*/
00476 
00477 
00478 void chainhashtable (hdlhashtable htable) {
00479     
00480     /*
00481     chain and unchain implement a stack of symbol tables.  the newest table is
00482     pointed to by currenthashtable, a global.  the global symbol table, the last in
00483     the list, points to nil.
00484     */
00485     
00486     register hdlhashtable ht = htable;
00487     
00488     (**ht).prevhashtable = currenthashtable;
00489     
00490     (**ht).flchained = true;
00491     
00492     currenthashtable = ht;
00493     } /*chainhashtable*/
00494 
00495 
00496 void unchainhashtable (void) {
00497     
00498     /*
00499     5.1.5b14 dmb: reset prevhashtable to nil
00500     */
00501     
00502     register hdlhashtable ht = currenthashtable;
00503     register hdlhashtable hprev = (**ht).prevhashtable;
00504     
00505     (**ht).prevhashtable = nil;
00506     
00507     (**ht).flchained = false;
00508     
00509     currenthashtable = hprev;
00510     } /*unchainhashtable*/
00511 
00512 
00513 #if 0
00514 
00515 static boolean indexhashtable_obsolete (short tablenum, hdlhashtable *htable) {
00516     
00517     /*
00518     turn an index into a hash table.  the most-global hashtable has index 0.
00519     its previous table is index 1.
00520     
00521     you can safely ask for the most-global one by asking for table number
00522     infinity, but watch out -- we return false if we fell off the list.
00523     */
00524 
00525     register hdlhashtable nomad = currenthashtable;
00526     register hdlhashtable prevnomad = nomad;
00527     register short ct = tablenum;
00528     register short i;
00529     
00530     for (i = 1; i <= ct; i++) {
00531         
00532         if (nomad == nil) { /*ran out of tables, return most-global table*/
00533             
00534             *htable = prevnomad;
00535             
00536             return (false);
00537             }
00538         
00539         prevnomad = nomad;
00540         
00541         nomad = (**nomad).prevhashtable;
00542         } /*for*/
00543         
00544     *htable = nomad; 
00545     
00546     return (true);
00547     } /*indexhashtable*/
00548 
00549 #endif
00550     
00551 
00552 hdlhashtable sethashtable (hdlhashtable hset) {
00553     
00554     /*
00555     5.0.2b6 dmb: utility routine for pushing using local storage
00556     */
00557     
00558     hdlhashtable hprev = currenthashtable;
00559     
00560     currenthashtable = hset;
00561     
00562     return (hprev);
00563     } /*sethashtable*/
00564 
00565 
00566 boolean pushhashtable (hdlhashtable h) {
00567     
00568     /*
00569     5.1.2 dmb: handle nil hs instead of asserting that it's not, If it's nil,
00570     the process globals have been disposed.
00571     */
00572     
00573     register hdltablestack hs = hashtablestack;
00574     
00575     if (hs == nil)
00576         return (false);
00577     
00578     if (!langcheckstacklimit (idtablestack, (**hs).toptables, cthashtables)) /*overflow!*/
00579         return (false);
00580     
00581     (**hs).stack [(**hs).toptables++] = currenthashtable;
00582     
00583     currenthashtable = h;
00584     
00585     /*stacktracer (toptables);*/
00586     
00587     return (true);
00588     } /*pushhashtable*/
00589 
00590 
00591 boolean pophashtable (void) {
00592     
00593     register hdltablestack hs = hashtablestack;
00594     
00595     if ((**hs).toptables <= 0) {
00596         
00597         shellinternalerror (idtoomanypophashtables, STR_too_many_pophashtables);
00598         
00599         return (false);
00600         }
00601     
00602     currenthashtable = (**hs).stack [--(**hs).toptables];
00603     
00604     /*stacktracer (toptables);*/
00605     
00606     return (true);
00607     } /*pophashtable*/
00608 
00609 
00610 boolean pushouterlocaltable (void) {
00611     
00612     /*
00613     push the local table with the most global scope -- the only table that 
00614     is global to the current process, but unique to it.
00615     */
00616     
00617     register hdlhashtable ht = currenthashtable;
00618     register hdlhashtable hprev;
00619     
00620     assert (ht != nil);
00621     
00622     assert ((**ht).fllocaltable); /*current hash table should be a local table*/
00623     
00624     while (true) {
00625         
00626         hprev = (**ht).prevhashtable;
00627         
00628         if ((hprev == nil) || !(**hprev).fllocaltable)
00629             return (pushhashtable (ht));
00630         
00631         ht = hprev;
00632         } /*while*/
00633     } /*pushouterlocaltable*/
00634 
00635 
00636 
00637 #ifdef smartmemory
00638 
00639 
00640 #include "tableverbs.h"
00641 
00642 /******/
00643 
00644 static boolean hashtablevisitall (hdlhashtable htable, boolean (*visit) (hdlhashnode)) {
00645     
00646     /*
00647     7/25/92 dmb: weird version of table visitation needed for purging tables:
00648     
00649     always visit all kids; return true if all kids return true, else false
00650     */
00651     
00652     register hdlhashnode x;
00653     register short i;
00654     register boolean fl = true;
00655     
00656     for (i = 0; i < ctbuckets; i++) {
00657         
00658         x = (**htable).hashbucket [i];
00659         
00660         while (x != nil) {
00661             
00662             hdlhashnode nextx = (**x).hashlink;
00663             
00664             if (!(*visit) (x)) 
00665                 fl = false;
00666             
00667             x = nextx;
00668             } /*while*/
00669         } /*for*/
00670     
00671     return (fl);
00672     } /*hashtablevisitall*/ 
00673 
00674 
00675 static boolean checkaddressvisit (hdlhashnode hnode) {
00676     
00677     /*
00678     7/25/92 dmb: weird version of table visitation needed for purging tables:
00679     
00680     always visit all kids; return true if all kids return true, else false
00681     */
00682     
00683     register hdlexternalvariable hv;
00684     tyvaluerecord val;
00685     hdlhashtable htable;
00686     bigstring bs;
00687     hdltreenode hcode;
00688     langerrorcallback errorcallback;
00689     
00690     val = (**hnode).val;
00691     
00692     switch (val.valuetype) {
00693         
00694         case addressvaluetype:
00695             getaddressvalue (val, &htable, bs);
00696             
00697             (**htable).flnopurge = true;
00698             
00699             break;
00700         
00701         case externalvaluetype:
00702             hv = (hdlexternalvariable) val.data.externalvalue;
00703             
00704             if (!(**hv).flinmemory)
00705                 break;
00706             
00707             if (langexternalvaltotable (val, &htable)) {
00708                 
00709                 hashtablevisitall (htable, checkaddressvisit);
00710                 
00711                 break;
00712                 }
00713             
00714             if (langexternalvaltocode (val, &hcode)) {
00715                 
00716                 if (langfinderrorrefcon ((long) hnode, &errorcallback)) /***/
00717                     (**htable).flnopurge = true;
00718                 
00719                 break;
00720                 }
00721             
00722             break;
00723         }
00724     
00725     return (true);
00726     } /*checkaddressvisit*/ 
00727 
00728 
00729 static boolean purgetablevisit (hdlhashnode hnode) {
00730     
00731     /*
00732     7/25/92 dmb: weird version of table visitation needed for purging tables:
00733     
00734     always visit all kids; return true if all kids return true, else false
00735     */
00736     
00737     register hdlexternalvariable hv;
00738     register hdlhashtable ht;
00739     tyvaluerecord val;
00740     hdlhashtable htable;
00741     boolean flnopurge;
00742     
00743     val = (**hnode).val;
00744     
00745     if (val.valuetype != externalvaluetype) 
00746         return (true);
00747     
00748     hv = (hdlexternalvariable) val.data.externalvalue;
00749     
00750     if (!(**hv).flinmemory)
00751         return (true);
00752     
00753     if (!langexternalvaltotable (val, &htable))
00754         return (true);
00755     
00756     ht = htable;
00757     
00758     flnopurge = (**ht).flnopurge;
00759     
00760     (**ht).flnopurge = false; /*must reset every time*/
00761     
00762     if ((**ht).fldirty)
00763         return (false);
00764     
00765     #if !flruntime
00766     
00767     if ((**ht).flwindowopen)
00768         return (false);
00769     
00770     #endif
00771     
00772     assert (!(**ht).fllocaltable);
00773     
00774     if ((**hnode).fldontsave)
00775         return (false);
00776     
00777     if (!hashtablevisitall (ht, purgetablevisit))
00778         return (false);
00779     
00780     if ((**ht).fllocked)
00781         return (false);
00782     
00783     if (flnopurge)
00784         return (false);
00785     
00786     tableverbunload (hv);
00787     
00788     return (true);
00789     } /*purgetablevisit*/   
00790 
00791 #endif
00792 
00793 boolean hashflushcache (long *ctbytesneeded) {
00794     
00795     register hdlhashtable hfreetable;
00796     
00797     #ifdef smartmemory
00798     
00799     hashtablevisitall (roottable, checkaddressvisit);
00800     
00801     hashtablevisitall (roottable, purgetablevisit);
00802     
00803     #endif
00804     
00805     while (hfirstfreetable != nil) {
00806         
00807         hfreetable = hfirstfreetable;
00808         
00809         hfirstfreetable = (**hfreetable).prevhashtable;
00810         
00811         *ctbytesneeded -= gethandlesize ((Handle) hfreetable);
00812         
00813         disposehandle ((Handle) hfreetable);
00814         }
00815     
00816     return (true);
00817     } /*hashflushcache*/
00818 
00819 
00820 boolean disposehashnode (hdlhashtable ht, hdlhashnode hnode, boolean fldisposevalue, boolean fldisk) {
00821     
00822     /*
00823     5.1.4 dmb: take htable parameter for database setting for disk scalars
00824     
00825     2003-05-22 AR: Call hashunregisteraddressnode at the lowest level
00826     possible to ensure that we don't encounter invalid hdlhashnodes
00827     later when we dispose a hashtable.
00828     */
00829 
00830     register hdlhashnode hn = hnode;
00831     
00832     /*
00833     if ((**hn).ctlocks > 0) {
00834         
00835         (**hn).fldisposewhenunlocked = true;
00836         
00837         return (false);
00838         }
00839     */
00840 
00841 #ifdef fltracklocaladdresses
00842     hashunregisteraddressnode (hnode);
00843 #endif  
00844 
00845     if (fldisposevalue) {
00846         
00847         boolean flneeddatabase = (fldisk && (**hn).val.fldiskval);
00848         hdldatabaserecord hdb = nil;
00849 
00850         if (flneeddatabase) {
00851             
00852             hdb = tablegetdatabase (ht);
00853 
00854             if (hdb)
00855                 dbpushdatabase (hdb);
00856             }
00857 
00858         disposevaluerecord ((**hn).val, fldisk);
00859         
00860         if (flneeddatabase && hdb)
00861             dbpopdatabase ();
00862         }
00863 
00864     disposehandle ((Handle) hn);
00865     
00866     return (true);
00867     } /*disposehashnode*/
00868 
00869 
00870 void dirtyhashtable (hdlhashtable ht) {
00871     
00872     (**ht).fldirty = true;
00873     
00874     (**ht).timelastsave = timenow ();
00875     } /*dirtyhashtable*/
00876 
00877     
00878 static short smashhashtable (hdlhashtable htable, boolean fldisk, boolean flcallback) {
00879     
00880     /*
00881     4.0b7 4/25/96 dmb: pulled this code out of disposehashtable
00882     so we could make a verb out of it. had to add the flcallback parameter,
00883     since disposehashtable doesn't want to.
00884     */
00885     
00886     register hdlhashtable ht = htable;
00887     register hdlhashnode nomad, nextnomad;
00888     register short i;
00889     short ctdisposed = 0;
00890     bigstring bs;
00891     
00892     if (ht == nil) /*easy to dispose of nil table*/
00893         return (0);
00894     
00895     (**ht).hfirstsort = nil;    /*disconnect now so table is valid during disposal*/
00896     
00897     for (i = 0; i < ctbuckets; i++) {
00898         
00899         nomad = (**ht).hashbucket [i];
00900         
00901         (**ht).hashbucket [i] = nil; /*disconnect list so table is valid during disposal*/
00902         
00903         while (nomad != nil) {
00904             
00905             nextnomad = (**nomad).hashlink;
00906             
00907             if (flcallback)
00908                 gethashkey (nomad, bs);
00909             
00910             if (flcallback)
00911                 langsymbolunlinking (ht, nomad);
00912             
00913             disposehashnode (ht, nomad, true, fldisk);
00914             
00915             if (flcallback)
00916                 langsymboldeleted (ht, bs);
00917             
00918             ++ctdisposed;
00919             
00920             nomad = nextnomad;
00921             } /*while*/
00922         } /*for*/
00923     
00924     dirtyhashtable (ht);
00925 
00926     return (ctdisposed); 
00927     } /*smashhashtable*/
00928 
00929 
00930 short emptyhashtable (hdlhashtable htable, boolean fldisk) {
00931 
00932     return (smashhashtable (htable, fldisk, true));
00933     } /*emptyhashtable*/
00934 
00935 boolean disposehashtable (hdlhashtable htable, boolean fldisk) {
00936     
00937     /*
00938     7/10/90 DW: if it's a local table, don't dispose of any code trees linked
00939     in as values.
00940     
00941     1/8/90 dmb: check new flchained flag to postpone disposal
00942     
00943     6/10/92 dmb: disconnect bucket list during disposal so table remains valid
00944     
00945     9/24/92 dmb: removed special case for code node value disposal.
00946     disposevaluerecord now knows that it should never dispose code values
00947     */
00948     
00949     register hdlhashtable ht = htable;
00950     
00951     if (ht == nil) /*easy to dispose of nil table*/
00952         return (true);
00953     
00954     #ifdef fldebug
00955     
00956     --cthashtablesallocated;
00957     
00958     #endif
00959     
00960     if (ht == roottable) { /*very serious internal error*/
00961     
00962         shellinternalerror (iddisposingsystemtable, STR_trying_to_dispose_global_symbol_table);
00963         
00964         return (false);
00965         }
00966     
00967     if ((**ht).flchained) { /*table is in local chain; can't dispose now*/
00968         
00969         (**ht).fldisposewhenunchained = true; /*we'll do it later*/
00970         
00971         return (true);
00972         }
00973     
00974     pushhashtable (ht);
00975     
00976     cleartmpstack ();
00977     
00978     pophashtable ();
00979     
00980     smashhashtable (ht, fldisk, false);
00981     /*
00982     for (i = 0; i < ctbuckets; i++) {
00983         
00984         nomad = (**ht).hashbucket [i];
00985         
00986         (**ht).hashbucket [i] = nil; /%disconnect list so table is valid during disposal%/
00987         
00988         while (nomad != nil) {
00989             
00990             /%
00991             boolean fldisposevalue;
00992             
00993             fldisposevalue = (!(**ht).fllocaltable) || ((**nomad).val.valuetype != codevaluetype);
00994             %/
00995             
00996             nextnomad = (**nomad).hashlink;
00997             
00998             disposehashnode (nomad, true /%fldisposevalue%/, fldisk);
00999             
01000             nomad = nextnomad;
01001             }
01002         }
01003     */
01004     
01005 #ifdef fltracklocaladdresses
01006     hashinvalidaterefnodes (ht);
01007 #endif
01008     
01009     (**ht).prevhashtable = hfirstfreetable;
01010     
01011     hfirstfreetable = ht;
01012     
01013     /*
01014     disposehandle ((Handle) ht);
01015     */
01016     
01017     return (true); 
01018     } /*disposehashtable*/
01019 
01020 
01021 short hashfunction (const bigstring bs) {
01022     
01023     /*
01024         3.0.4b8 dmb: need to make locals unsigned to protect against ctype's int's
01025     */
01026 
01027 //  register unsigned short c;
01028     register unsigned short len;
01029 //  register ptrstring p = (ptrstring) bs;
01030     register unsigned short val;
01031 
01032     len = stringlength (bs);
01033     
01034     if (len == 0)
01035         return (0);
01036     
01037 //  c = p [1];
01038     
01039     val = getlower(getstringcharacter(bs,0));
01040     
01041 //  c = p [len];
01042     
01043     val += getlower(getstringcharacter(bs,len-1));
01044     
01045     return (val % ctbuckets);
01046     } /*hashfunction*/
01047 
01048 
01049 static boolean hashsortedinsert (hdlhashnode hnode) {
01050 
01051     register hdlhashnode hn = hnode;
01052     register hdlhashtable ht = currenthashtable;
01053     register hdlhashnode nomad = (**ht).hfirstsort;
01054     register hdlhashnode nomadprev = nil;
01055     short comparison;
01056     
01057     if (nomad == nil) { /*first guy in sorted list*/
01058         
01059         (**ht).hfirstsort = hn;
01060         
01061         (**hn).sortedlink = nil;
01062         
01063         return (true);
01064         }
01065     
01066     while (true) {
01067         
01068         comparison = (*langcallbacks.comparenodescallback) (ht, hn, nomad);
01069         
01070         if (comparison < 0) {
01071             
01072             if (nomadprev == nil) { /*he's the new first element*/  
01073                 
01074                 (**hn).sortedlink = (**ht).hfirstsort;
01075                 
01076                 (**ht).hfirstsort = hn;
01077                 
01078                 return (true);
01079                 }
01080                 
01081             (**hn).sortedlink = nomad; /*insert in before nomad, middle of list*/
01082             
01083             (**nomadprev).sortedlink = hn;
01084             
01085             return (true);
01086             }
01087         
01088         nomadprev = nomad; /*advance to next node in list*/
01089         
01090         nomad = (**nomad).sortedlink; /*advance to next node in sorted list*/
01091         
01092         if (nomad == nil) { /*insert at end of list*/
01093             
01094             (**hn).sortedlink = nil;
01095             
01096             (**nomadprev).sortedlink = hn;
01097             
01098             return (true);
01099             }
01100         } /*while*/
01101     } /*hashsortedinsert*/
01102     
01103 
01104 static void hashsorteddelete (hdlhashnode hnodedelete) {
01105     
01106     register hdlhashtable htable = currenthashtable;
01107     register hdlhashnode nomad = (**htable).hfirstsort;
01108     register hdlhashnode nomadprev = nil;
01109     register hdlhashnode hnode = hnodedelete;
01110     
01111     while (nomad != nil) {
01112         
01113         if (nomad == hnode) {
01114             
01115             if (nomadprev == nil) { /*unlinking first in list*/
01116             
01117                 (**htable).hfirstsort = (**nomad).sortedlink;
01118                 
01119                 return;
01120                 }
01121                 
01122             (**nomadprev).sortedlink = (**nomad).sortedlink;
01123             
01124             return;
01125             }
01126         
01127         nomadprev = nomad;
01128         
01129         nomad = (**nomad).sortedlink;
01130         } /*while*/
01131     } /*hashsorteddelete*/
01132     
01133     
01134 static boolean hashlinknode (hdlhashtable htable, hdlhashnode hnode) {
01135     
01136     register hdlhashnode hn = hnode;
01137     register hdlhashtable ht = htable;
01138     register short ixbucket;
01139     register hdlhashnode hnext;
01140     
01141     ixbucket = hashfunction ((**hn).hashkey);
01142     
01143     hnext = (**ht).hashbucket [ixbucket];
01144     
01145     (**ht).hashbucket [ixbucket] = hnode; /*link new guy at head of list*/
01146     
01147     (**hn).hashlink = hnext;
01148     
01149     return (true);
01150     } /*hashlinknode*/
01151     
01152 
01153 boolean hashinsertnode (hdlhashnode hnode, hdlhashtable htable) {
01154     
01155     /*
01156     3/23/93 dmb: don't invoke callback when flunpackingtable flag is set
01157     */
01158     
01159     register hdlhashnode hn = hnode;
01160     register hdlhashtable ht = htable;
01161     bigstring bs;
01162     
01163     hashlinknode (ht, hn);
01164     
01165     if (flunpackingtable) /*tableunpack will take care of sort links*/
01166         return (true);
01167     
01168     pushhashtable (ht);
01169     
01170     hashsortedinsert (hn);
01171     
01172     pophashtable ();
01173     
01174     dirtyhashtable (ht);
01175     
01176     gethashkey (hn, bs);
01177     
01178     langsymbolinserted (ht, bs, hn);
01179     
01180     return (true);
01181     } /*hashinsertnode*/
01182     
01183 
01184 boolean hashunlinknode (hdlhashtable htable, hdlhashnode hnode) {
01185     
01186     /*
01187     a sure-fire hash-algorithm-independent way to unlink a node.
01188     */
01189     
01190     register short i;
01191     register hdlhashnode nomad, prev;
01192     
01193     for (i = 0; i < ctbuckets; i++) {
01194         
01195         nomad = (**htable).hashbucket [i];
01196         
01197         prev = nil;
01198         
01199         while (nomad != nil) {
01200             
01201             if (nomad == hnode) /*found it*/
01202                 goto afterloop;
01203                 
01204             prev = nomad;
01205             
01206             nomad = (**nomad).hashlink;
01207             } /*while*/
01208         } /*for*/
01209     
01210     return (false); /*not found*/
01211     
01212     afterloop:
01213     
01214     if (prev == nil) 
01215         (**htable).hashbucket [i] = (**nomad).hashlink;
01216     else
01217         (**prev).hashlink = (**nomad).hashlink;
01218     
01219     return (true);
01220     } /*hashunlinknode*/
01221 
01222 
01223 boolean hashsetnodekey (hdlhashtable htable, hdlhashnode hnode, const bigstring bs) {
01224     
01225     if (!sethandlesize ((Handle) hnode, sizeof (tyhashnode) + stringsize (bs)))
01226         return (false);
01227     
01228     hashunlinknode (htable, hnode);
01229     
01230     copystring (bs, (**hnode).hashkey);
01231     
01232     hashlinknode (htable, hnode);
01233     
01234     (**htable).flneedsort = true;
01235     
01236     langsymbolchanged (htable, bs, hnode, false); /*value didn't change*/
01237     
01238     return (true);
01239     } /*hashsetnodekey*/
01240 
01241 
01242 static boolean newhashnode (hdlhashnode *hnode, const bigstring bskey) {
01243     
01244     if (!newclearhandle (sizeof (tyhashnode) + stringsize (bskey), (Handle *) hnode))
01245         return (false);
01246     
01247     copystring (bskey, (***hnode).hashkey);
01248     
01249     return (true);
01250     } /*newhashnode*/
01251 
01252 
01253 boolean hashinsert (const bigstring bs, tyvaluerecord val) {
01254     
01255     /*
01256     5.0.2b10 dmb: make sure we don't put a value with the tmp flag set.
01257     */
01258     
01259     register hdlhashtable ht = currenthashtable;
01260     register hdlhashnode h;
01261     hdlhashnode hnode;
01262     
01263     if (isemptystring (bs)) {
01264         bigstring bspath;
01265         
01266         langexternalgetfullpath (currenthashtable, (ptrstring) bs, bspath, nil);
01267         
01268         lang2paramerror (illegalnameerror, bspath, bs);
01269         
01270         return (false);
01271         }
01272     
01273     if (!newhashnode (&hnode, bs))
01274         return (false);
01275     
01276     h = hnode; /*copy into register*/
01277     
01278     hnewnode = h; /*copy into global for hashinsertaddress*/
01279     
01280     val.fltmpstack = false; // 5.0.2: caller is responsible for actually removing it
01281     
01282     (**h).val = val;
01283     
01284     hashinsertnode (h, ht);
01285     
01286     return (true);
01287     } /*hashinsert*/
01288     
01289 
01290 /*
01291 hashmerge (hdlhashtable hsource, hdlhashtable hdest) {
01292     
01293     /%
01294     merge hsource into hdest, leaving hsource empty.  since it consumes 
01295     no memory (we just unlink nodes and deposit them) it can't fail.
01296     %/
01297     
01298     register short i;
01299     
01300     for (i = 0; i < ctbuckets; i++) {
01301         
01302         register hdlhashnode x;
01303         
01304         x = (**hsource).hashbucket [i];
01305         
01306         while (x != nil) { /%chain through the hash list%/
01307             
01308             register hdlhashnode nextx; 
01309             
01310             nextx = (**x).hashlink;
01311             
01312             hashinsertnode (x, hdest);
01313             
01314             x = nextx;
01315             } /%while%/
01316             
01317         (**hsource).hashbucket [i] = nil; /%we leave the source table empty%/
01318         } /%for%/
01319     } /%hashmerge%/
01320 */
01321 
01366 boolean hashlocate (const bigstring bs, hdlhashnode *hnode, hdlhashnode *hprev) {
01367 
01368     /*
01369     7/15/90 DW: add support for table array-style references.  if the string
01370     begins with a $, we return the node and prev for the nth guy in the sorted
01371     list of the table.
01372     */
01373     
01374     register short ixbucket;
01375     register hdlhashnode nomad, nomadprev;
01376     
01377     /*
01378     short arrayindex;
01379     
01380     if (hashstringtoarrayindex (bs, &arrayindex)) {
01381     
01382         return (hashlocatearray (arrayindex, hnode, hprev));
01383         }
01384     */
01385     
01386     ixbucket = hashfunction (bs);
01387 
01388     //assert (currenthashtable != nil);
01389 
01390     //assert (validhandle ((Handle) currenthashtable));
01391     
01392     nomad = (**currenthashtable).hashbucket [ixbucket];
01393     
01394     nomadprev = nil;
01395     
01396     while (nomad != nil) {
01397         
01398         if (equalidentifiers (bs, (**nomad).hashkey)) {
01399         
01400             *hnode = nomad;
01401             
01402             *hprev = nomadprev;
01403             
01404             return (true);
01405             }
01406         
01407         nomadprev = nomad;
01408         
01409         nomad = (**nomad).hashlink;
01410         } /*while*/
01411         
01412     return (false); /*loop terminated, not found*/
01413     } /*hashlocate*/
01414 
01415 
01416 boolean hashunlink (const bigstring bs, hdlhashnode *hnode) {
01417     
01418     hdlhashnode hprev;
01419     register hdlhashnode hn;
01420     
01421     if (!hashlocate (bs, hnode, &hprev)) {
01422     
01423         langparamerror (cantdeleteerror, bs);
01424         
01425         return (false);
01426         }
01427     
01428     hn = *hnode; /*copy into register*/
01429     
01430     langsymbolunlinking (currenthashtable, hn);
01431     
01432     if (hprev == nil) 
01433         (**currenthashtable).hashbucket [hashfunction (bs)] = (**hn).hashlink;
01434     else 
01435         (**hprev).hashlink = (**hn).hashlink;
01436     
01437     hashsorteddelete (hn);
01438     
01439     dirtyhashtable (currenthashtable);
01440     
01441     langsymboldeleted (currenthashtable, bs);
01442     
01443     return (true);
01444     } /*hashunlink*/
01445 
01446 /*
01447 boolean hashdeletenode (hdlhashnode *hnode) {
01448     
01449     hdlhashnode hprev;
01450     register hdlhashnode hn;
01451     
01452     hashunlinknode (currenthashtable, hnode);
01453     
01454     hashsorteddelete (hnode);
01455     
01456     dirtyhashtable (currenthashtable);
01457     
01458     return (true);
01459     } /%hashdeletenode%/
01460 */
01461 
01462 
01463 boolean hashdelete (const bigstring bs, boolean fldisposevalue, boolean fldisk) {
01464     
01465     hdlhashnode hnode, hprev;
01466     register hdlhashnode hn;
01467     
01468     if (!hashlocate (bs, &hnode, &hprev)) {
01469     
01470         langparamerror (cantdeleteerror, bs);
01471         
01472         return (false);
01473         }
01474     
01475     hn = hnode; /*copy into register*/
01476     
01477     langsymbolunlinking (currenthashtable, hn);
01478     
01479     if (hprev == nil) 
01480         (**currenthashtable).hashbucket [hashfunction (bs)] = (**hn).hashlink;
01481     else 
01482         (**hprev).hashlink = (**hn).hashlink;
01483     
01484     hashsorteddelete (hn);
01485     
01486     disposehashnode (currenthashtable, hn, fldisposevalue, fldisk);
01487     
01488     dirtyhashtable (currenthashtable);
01489     
01490     langsymboldeleted (currenthashtable, bs);
01491     
01492     return (true);
01493     } /*hashdelete*/
01494 
01495 
01496 boolean hashtabledelete (hdlhashtable htable, bigstring bs) {
01497     
01498     boolean fl;
01499 
01500     if (!pushhashtable (htable))
01501         return (false);
01502     
01503     fl = hashdelete (bs, true, true);
01504     
01505     pophashtable ();
01506 
01507     return (fl);
01508     } /*hashtabledelete*/
01509 
01510 
01511 boolean hashsymbolexists (const bigstring bs) {
01512     
01513     hdlhashnode hnode, hprev;
01514     
01515     return (hashlocate (bs, &hnode, &hprev));
01516     } /*hashsymbolexists*/
01517 
01518 
01519 boolean hashtablesymbolexists (hdlhashtable htable, const bigstring bs) {
01520     
01521     boolean fl;
01522     
01523     pushhashtable (htable);
01524     
01525     fl = hashsymbolexists (bs);
01526     
01527     pophashtable ();
01528     
01529     return (fl);
01530     } /*hashtablesymbolexists*/
01531 
01532 
01533 typedef struct localityinfo {
01534     
01535     boolean fllocal;
01536 
01537     hdldatabaserecord hdb;
01538     } tylocalityinfo, *ptrlocalityinfo;
01539 
01540 
01541 static boolean hashsetlocalityvisit (hdlhashnode hnode, ptrvoid refcon) {
01542     
01543     hdlhashtable ht;
01544     hdlexternalvariable hv;
01545     tyvaluerecord val = (**hnode).val;
01546     ptrlocalityinfo info = (ptrlocalityinfo) refcon;
01547     
01548     if (val.valuetype == externalvaluetype) {
01549         
01550         hv = (hdlexternalvariable) val.data.externalvalue;
01551         
01552         if (currenthashtable != filewindowtable)
01553             langexternalsetdatabase (hv, (*info).hdb);
01554         
01555         if ((**hv).flinmemory && langexternalvaltotable (val, &ht, hnode)) {
01556             
01557             (**ht).fllocaltable = (*info).fllocal;
01558             
01559             hashtablevisit (ht, &hashsetlocalityvisit, info);
01560             }
01561         }
01562     
01563     return (true); /*always continue traversal*/
01564     } /*hashsetlocalityvisit*/
01565 
01566 
01567 void hashsetlocality (tyvaluerecord *val, boolean fllocal) {
01568     
01569     /*
01570     5.0.2b10 dmb: new routine. when we assign a table value to a local
01571     table, it and all of its subtables must be local too. Or the converse.
01572     
01573     5.0.2b13 dmb: set the table's parent link. we now maintain it strictly.
01574     
01575     5.1.4 dmb: deal with database ownership for newly-created externals
01576 
01577     encode address value according to locality
01578     
01579     6.2b16 AR: No longer static so it can be called externally (langaddlocals, langevaluate.c)
01580     */
01581     
01582     hdlhashtable ht;
01583     hdlexternalvariable hv;
01584     
01585     tylocalityinfo info;
01586 
01587     switch ((*val).valuetype) {
01588         
01589         case addressvaluetype:
01590 
01591             disablelangerror (); /*08/02/2000 AR*/
01592             
01593             setaddressencoding (val, !fllocal);
01594 
01595             enablelangerror ();
01596 
01597             break;
01598     
01599         case externalvaluetype:
01600             
01601             hv = (hdlexternalvariable) (*val).data.externalvalue;
01602             
01603             info.fllocal = fllocal;
01604             
01605             if (currenthashtable != filewindowtable) {
01606                 
01607                 info.hdb = tablegetdatabase (currenthashtable);
01608                 
01609                 langexternalsetdatabase (hv, info.hdb);
01610                 }
01611             
01612             if (!(**hv).flinmemory || !langexternalvaltotable (*val, &ht, nil))
01613                 break;
01614             
01615             (**ht).parenthashtable = currenthashtable;
01616             
01617             (**ht).fllocaltable = fllocal;
01618             
01619             hashtablevisit (ht, &hashsetlocalityvisit, &info);
01620 
01621             break;
01622 
01623         default:
01624             break;
01625         }
01626     } /*hashsetlocality*/
01627 
01628 
01629 boolean hashassign (const bigstring bs, tyvaluerecord val) {
01630     
01631     /*
01632     9/23/91 dmb: no longer clear fllangerror, or look at it when 
01633     hashlocate returns false.  array references are implemented differently 
01634     now, and hashlocate never generates errors.  clearing fllangerror can 
01635     have the side effect of hiding an error condition unexpectedly.
01636     
01637     5.0b17 dmb: if we're assigning a tmp external, claim the data like 
01638     a normal tmp. don't copy the data, clean fltmpdata instead. really, our
01639     caller should be exempting from the tmp stack, but this close to shipping
01640     let's not assume more than we have to
01641 
01642     5.0.1b1 dmb: the b17 change broke stuff, because the object may be in 
01643     another table's temp stack. Our caller is responsible for exempting 
01644     anything assinged into a table. we just need to make sure that the 
01645     fltmpstack flag is clear for _any_ object we assign to a hashnode
01646 
01647     5.0.1b2 dmb: when disposing a value, set fldisk false for local table items
01648     
01649     5.0.2b13 dmb: set fltmpdata false & call hashsetlocality before hashinsert case
01650     */
01651     
01652     hdlhashnode hnode, hprev;
01653     tyvaluerecord existingval;
01654     boolean fllocal = (**currenthashtable).fllocaltable;
01655     
01656     /*
01657     fllangerror = false;
01658     */
01659     
01660     if (val.fltmpdata) { /*val doesn't own it's data*/
01661         
01662         if (val.fltmpstack)
01663             val.fltmpdata = false;
01664         else
01665             if (!copyvaluedata (&val))
01666                 return (false);
01667         }
01668     
01669     val.fltmpstack = false; // 5.0.1: caller is responsible for actually removing it
01670     
01671     //if (val.valuetype == externalvaluetype) // 5.0.2: localness of tables must match parent
01672         hashsetlocality (&val, fllocal);
01673     
01674     if (!hashlocate (bs, &hnode, &hprev)) { /*the name doesn't exist or is invalid*/
01675         
01676         /*just an undefined variable*/
01677         
01678         return (hashinsert (bs, val));
01679         }
01680     
01681     existingval = (**hnode).val;
01682     
01683     if (fllanghashassignprotect) { /*protect externals from being smashed by assignment*/
01684         
01685         if ((existingval.valuetype == externalvaluetype) && (val.valuetype != externalvaluetype)) {
01686             bigstring bstype;
01687             
01688             langexternaltypestring ((hdlexternalhandle) existingval.data.externalvalue, bstype);
01689             
01690             lang2paramerror (badexternalassignmenterror, bstype, bs);
01691             
01692             return (false);
01693             }
01694         }
01695     
01696     /*carefully nuke existing value*/ {
01697         
01698         boolean flneeddatabase = (!fllocal && existingval.fldiskval);
01699         hdldatabaserecord hdb = nil;
01700 
01701         if (flneeddatabase) {
01702             
01703             hdb = tablegetdatabase (currenthashtable);
01704 
01705             if (hdb)
01706                 dbpushdatabase (hdb);
01707             }
01708 
01709         disposevaluerecord (existingval, !fllocal);
01710         
01711         if (flneeddatabase && hdb)
01712             dbpopdatabase ();
01713         }
01714     
01715     (**hnode).val = val;
01716     
01717     langsymbolchanged (currenthashtable, bs, hnode, true); /*value changed*/
01718     
01719     return (true);
01720     } /*hashassign*/
01721 
01722 
01723 boolean hashtableassign (hdlhashtable htable, const bigstring bs, tyvaluerecord val) {
01724     
01725     boolean fl;
01726     
01727     pushhashtable (htable);
01728     
01729     fl = hashassign (bs, val);
01730     
01731     pophashtable ();
01732     
01733     return (fl);
01734     } /*hashtableassign*/
01735 
01736 
01737 boolean hashresolvevalue (hdlhashtable htable, hdlhashnode hnode) {
01738     
01739     /*
01740     3/19/92 dmb: try to resolve an address -- it hasn't been referenced since 
01741     it was unpacked.
01742     
01743     4.0.2b1 dmb: handle disk-based scalar values. load the value and release
01744     the dbaddress. added htable parameter so we can potentially dirty it 
01745     
01746     5.0a23 dmb: on address resolution failure, reset flunresolvedaddress to true
01747     
01748     5.0b7 dmb: don't set flunresolvedaddress to true on failure. It breaks 
01749     the table display. don't know why exactly.
01750 
01751     5.1.4 dmb: no longer resolve addresses automatically. It's now a valid state.
01752     Exception: the paths table needs high-performance address access
01753 
01754     5.1.4 dmb: dbpushreleasestack must be while database is pushed
01755     */
01756     
01757     register hdlhashnode hn = hnode;
01758     boolean fl;
01759     
01760     #ifdef version5orgreater
01761     if (htable == pathstable && (**hn).flunresolvedaddress) {
01762 
01763         (**hn).flunresolvedaddress = false; /*clear now to avoid potential recursion*/
01764         
01765         lockhandle ((Handle) hn); /*08/02/2000 AR: so it's safe to pass &(**hn).val to setaddressencoding*/
01766         
01767         disablelangerror ();
01768         
01769         fl = setaddressencoding (&(**hn).val, false);
01770         
01771         enablelangerror ();
01772     
01773         unlockhandle ((Handle) hn);
01774         
01775         if (!fl)
01776             return (false);
01777         }
01778     #else
01779     register hdlstring hstring;
01780     bigstring bs;
01781     if ((**hn).flunresolvedaddress) {
01782 
01783         (**hn).flunresolvedaddress = false; /*clear now to avoid potential recursion*/
01784         
01785         hstring = (**hn).val.data.addressvalue;
01786         
01787         copyheapstring (hstring, bs);
01788         
01789         pushhashtable (roottable);
01790         
01791         disablelangerror ();
01792         
01793         fl = langexpandtodotparams (bs, &htable, bs);
01794         
01795         enablelangerror ();
01796         
01797         pophashtable ();
01798         
01799         if (!fl) {
01800 
01801         //  (**hn).flunresolvedaddress = true; /*didn't actually resolve it*/
01802             
01803             return (false);
01804             }
01805 
01806         setheapstring (bs, hstring); /*now we have just the name*/
01807         
01808         enlargehandle ((Handle) hstring, sizeof (hdlhashtable), &htable); /*should never fail*/
01809         }
01810     #endif
01811 
01812     if ((**hn).val.fldiskval) {
01813         Handle hbinary;
01814         hdldatabaserecord hdb = tablegetdatabase (htable);
01815         
01816         if (hdb)
01817             dbpushdatabase (hdb);
01818         
01819         fl = dbrefhandle ((**hn).val.data.diskvalue, &hbinary);
01820         
01821         if (fl)
01822             dbpushreleasestack ((**hn).val.data.diskvalue, (long) langgettype ((**hn).val));
01823         
01824         if (hdb)
01825             dbpopdatabase ();
01826         
01827         if (!fl)
01828             return (false);
01829         
01830         (**htable).fldirty = true;  /*dmb 6/18/96: we released disk value, must force table to be resaved*/
01831         
01832         (**hn).val.data.binaryvalue = hbinary;
01833         
01834         (**hn).val.fldiskval = false;
01835         }
01836     
01837     return (true);
01838     } /*hashresolvevalue*/
01839 
01840 
01841 boolean hashlookup (const bigstring bs, tyvaluerecord *vreturned, hdlhashnode *hnode) {
01842     
01843     /*
01844     3/19/92 dmb: must check for unresolved addresses here
01845     */
01846     
01847     hdlhashnode hprev;
01848     
01849     if (!hashlocate (bs, hnode, &hprev)) 
01850         return (false);
01851     
01852     if (!hashresolvevalue (currenthashtable, *hnode))
01853         return (false);
01854     
01855     *vreturned = (***hnode).val;
01856     
01857     return (true);
01858     } /*hashlookup*/
01859     
01860 
01861 boolean hashtablelookup (hdlhashtable htable, const bigstring bs, tyvaluerecord *vreturned, hdlhashnode *hnode) {
01862     
01863     boolean fl;
01864 
01865     if (htable == nil)  /*8.0b48 PBS: it *is* nil sometimes. Too many callers would have to check it,*/
01866         return (false); /*so the check is done here.*/
01867     
01868     
01869     pushhashtable (htable);
01870     
01871     fl = hashlookup (bs, vreturned, hnode);
01872     
01873     pophashtable ();
01874     
01875     return (fl);
01876     } /*hashtablelookup*/
01877 
01878 
01879 boolean hashlookupnode (const bigstring bs, hdlhashnode *hnode) {
01880     
01881     /*
01882     3/19/92 dmb: must check for unresolved addresses here
01883     */
01884     
01885     hdlhashnode hprev;
01886     
01887     if (!hashlocate (bs, hnode, &hprev))
01888         return (false);
01889     
01890     return (hashresolvevalue (currenthashtable, *hnode));
01891     } /*hashlookupnode*/
01892 
01893 
01894 boolean hashtablelookupnode (hdlhashtable htable, const bigstring bs, hdlhashnode *hnode) {
01895     
01896     boolean fl;
01897     
01898     pushhashtable (htable);
01899     
01900     fl = hashlookupnode (bs, hnode);
01901     
01902     pophashtable ();
01903     
01904     return (fl);
01905     } /*hashtablelookupnode*/
01906 
01907 
01908 static boolean hashinsertaddress (bigstring bsname, bigstring bsval) {
01909     
01910     /*
01911     3/19/92 dmb: discovered critical bug: if we try to resolve address references 
01912     here, using langexpandtodotparams, an address that references the table 
01913     being unpacked will generate infinite recursion.  That answer is to leave 
01914     the address in its string format for now, and then resolve the address when 
01915     it's referenced through a hashlookup.  this necessitated adding a new flag 
01916     to the hashrecord, and introducing the hnewnode global so we know what node 
01917     was created by hashinsert.  also, to preserve the original path information 
01918     and coordinate with getaddressvalue, we adopted a new convention of using 
01919     a hashtable of -1 to indicate an unresvoled address value.
01920     */
01921     
01922     tyvaluerecord val;
01923     
01924     if (!setaddressvalue ((hdlhashtable) -1, bsval, &val))
01925         return (false);
01926     
01927     if (!hashinsert (bsname, val))
01928         return (false);
01929     
01930     exemptfromtmpstack (&val);
01931     
01932     (**hnewnode).flunresolvedaddress = true;
01933     
01934     return (true);
01935     } /*hashinsertaddress*/
01936 
01937 
01938 /*
01939 static boolean hashinsertaddress (bigstring bsname, bigstring bsval) {
01940     
01941     tyvaluerecord val;
01942     hdlhashtable htable;
01943     bigstring bs;
01944     boolean fl;
01945     
01946     pushhashtable (roottable);
01947     
01948     disablelangerror ();
01949     
01950     if (langexpandtodotparams (bsval, &htable, bs))
01951         fl = setaddressvalue (htable, bs, &val);
01952     else
01953         fl = setstringvalue (bsval, &val);
01954     
01955     enablelangerror ();
01956     
01957     pophashtable ();
01958     
01959     if (!fl)
01960         return (false);
01961     
01962     if (!hashinsert (bsname, val))
01963         return (false);
01964     
01965     pushhashtable (roottable);
01966     
01967     exemptfromtmpstack (val);
01968     
01969     pophashtable ();
01970     
01971     return (true);
01972     } /%hashinsertaddress%/
01973 */
01974 
01975 
01976 boolean hashtablevisit (hdlhashtable htable, langtablevisitcallback visit, ptrvoid refcon) {
01977     
01978     /*
01979     ###4.0.2b1 warning: scalar node values may now be on disk. callers that may 
01980     be examining strings values must handle this. (currently these are no such callers.)
01981     */
01982     
01983     register hdlhashnode x;
01984     register short i;
01985     
01986     for (i = 0; i < ctbuckets; i++) {
01987         
01988         x = (**htable).hashbucket [i];
01989         
01990         while (x != nil) {
01991             
01992             hdlhashnode nextx = (**x).hashlink;
01993             
01994             if (!(*visit) (x, refcon)) 
01995                 return (false);
01996                 
01997             x = nextx;
01998             } /*while*/
01999         } /*for*/
02000     
02001     return (true);
02002     } /*hashtablevisit*/
02003 
02004 
02005 static int hashcompare (const void *h1, const void *h2) {
02006     
02007     return ((*langcallbacks.comparenodescallback) (currenthashtable, *(hdlhashnode *)h1, *(hdlhashnode *)h2));
02008     } /*hashcompare*/
02009 
02010 
02011 static boolean hashquicksort (hdlhashtable htable) {
02012     
02013     /*
02014     3/31/93 dmb: re-sort the indicated hashtable, using the standard c 
02015     library quicksort routine. this is really fast in general, but note 
02016     that it's worst-case performance is an already-sorted list.
02017     */
02018     
02019     register hdlhashtable ht = htable;
02020     long ctitems;
02021     Handle hlist;
02022     register hdlhashnode h;
02023     
02024     hashcountitems (ht, &ctitems);
02025     
02026     if (ctitems == 0)
02027         return (true);
02028     
02029     if (!newhandle (ctitems * sizeof (hdlhashnode), &hlist))
02030         return (false);
02031     
02032     lockhandle (hlist);
02033     
02034     /*populate the array*/ {
02035         
02036         register hdlhashnode *p = (hdlhashnode *) *hlist;
02037         
02038         for (h = (**ht).hfirstsort; h != nil; h = (**h).sortedlink)
02039             *p++ = h;
02040         }
02041     
02042     /*sort it*/ {
02043         
02044         pushhashtable (ht);
02045         
02046         #ifdef THINK_C
02047         
02048             qsort (*hlist, ctitems, sizeof (hdlhashnode), (__cmp_func) &hashcompare);
02049         
02050         #else
02051         
02052             qsort (*hlist, ctitems, sizeof (hdlhashnode), &hashcompare);
02053         
02054         #endif
02055         
02056         pophashtable ();
02057         }
02058     
02059     /*link the list*/ {
02060         
02061         register hdlhashnode *p = (hdlhashnode *) *hlist;
02062         
02063         (**ht).hfirstsort = *p;
02064         
02065         while (--ctitems > 0) {
02066             
02067             (***p).sortedlink = *(p + 1);
02068             
02069             ++p;
02070             }
02071         
02072         (***p).sortedlink = nil;
02073         }
02074     
02075     unlockhandle (hlist);
02076 
02077     disposehandle (hlist);
02078     
02079     (**ht).flneedsort = false;
02080     
02081     return (true);
02082     } /*hashquicksort*/
02083 
02084 
02085 boolean hashresort (hdlhashtable htable, hdlhashnode hresort) {
02086     
02087     /*
02088     re-sort the indicated hashtable.  first empty out the sorted list, then 
02089     visit every node in the table re-inserting it into the sorted list.
02090     
02091     3/31/93 dmb: added hresort parameter. if it's not nil, then only that 
02092     node needs to be resorted. using the quicksort routine, it's especially 
02093     important not to resort a mostly-sorted list just to move one node.
02094     */
02095     
02096     register hdlhashtable ht = htable;
02097     
02098     if (hresort == nil)
02099         return (hashquicksort (ht));
02100     
02101     pushhashtable (ht);
02102     
02103     hashsorteddelete (hresort);
02104     
02105     hashsortedinsert (hresort);
02106     
02107     pophashtable ();
02108     
02109     (**ht).flneedsort = false; // this may be a bug. we don't know if this was only unsorted node
02110     
02111     return (true);
02112     } /*hashresort*/
02113 
02114 
02115 boolean hashinversesearch (hdlhashtable htable, langinversesearchcallback visit, ptrvoid refcon, bigstring bsname) {
02116 
02117     /*
02118     perform a relatively slow, content-based search.
02119     
02120     we call the visit routine for every node in the current hashtable.
02121     
02122     if he returns false, we keep going -- he hasn't found the thing he's looking
02123     for yet.  if true, we return with the value of the node we stopped on.
02124     
02125     we return false if the visit routine never returns true.
02126     
02127     ###4.0.2b1 warning: scalar node values may now be on disk. callers that may 
02128     be examining strings values must handle this. (currently these are no such callers.)
02129     */
02130     
02131     register hdlhashnode nomad;
02132     register short i;
02133     
02134     for (i = 0; i < ctbuckets; i++) {
02135         
02136         nomad = (**htable).hashbucket [i];
02137         
02138         while (nomad != nil) {
02139         
02140             gethashkey (nomad, bsname);
02141                 
02142             if ((*visit) (bsname, nomad, (**nomad).val, refcon)) /*search is over*/
02143                 return (true);
02144                 
02145             nomad = (**nomad).hashlink;
02146             } /*while*/
02147         } /*for*/
02148     
02149     setemptystring (bsname);
02150     
02151     return (false); /*never found the node he wanted*/
02152     } /*hashinversesearch*/
02153 
02154 
02155 boolean hashsortedinversesearch (hdlhashtable htable, langsortedinversesearchcallback visit, ptrvoid refcon) {
02156 
02157     /*
02158     like hashinversesearch, except that items are visited in the current 
02159     sort order
02160     
02161     we return false if the visit routine never returns true.
02162     
02163     ###4.0.2b1 warning: scalar node values may now be on disk. the value 
02164     that we pass to the visit routine may be unresolved. callers that may 
02165     be examining strings must handle this. (currently these are langipcgetparamvisit,
02166     tablefind, and tableverbpacktotext
02167 
02168     */
02169     
02170     register hdlhashnode nomad = (**htable).hfirstsort;
02171     bigstring bsname;
02172     
02173     while (nomad != nil) {
02174         
02175         gethashkey (nomad, bsname);
02176         
02177         if ((*visit) (bsname, nomad, (**nomad).val, refcon)) /*search is over*/
02178             return (true);
02179         
02180         nomad = (**nomad).sortedlink;
02181         } /*while*/
02182     
02183     return (false); /*never found the node he wanted*/
02184     } /*hashsortedinversesearch*/
02185 
02186 
02187 static boolean nodeintablevisit (hdlhashnode hnode, ptrvoid refcon) {
02188     
02189     return (hnode != (hdlhashnode) refcon); /*false terminates traversal*/
02190     } /*nodeintablevisit*/
02191 
02192 
02193 boolean hashnodeintable (hdlhashnode hnode, hdlhashtable htable) {
02194     
02195     /*
02196     search the indicated table for the node, return true if we find it.
02197     */
02198     
02199     if (htable == nil) // watch your back!
02200         return (false);
02201     
02202     return (!hashtablevisit (htable, &nodeintablevisit, hnode));
02203     } /*hashnodeintable*/
02204 
02205 
02206 static boolean hashpackstring (handlestream *s, bigstring bs, long *ix) {
02207     
02208     *ix = (*s).pos;
02209 
02210     return (writehandlestream (s, (ptrvoid) bs, (long) stringsize (bs)));
02211     } /*hashpackstring*/
02212 
02213 
02214 static void hashunpackstring (Handle hget, bigstring bs, long ix) {
02215     
02216     /*
02217     5.0.1 rab: p must point to unsigned
02218     */
02219 
02220     register ptrbyte p;
02221     
02222     p = (ptrbyte)(*hget + ix);
02223     
02224     moveleft (p, bs, (unsigned long) *p + 1);
02225     } /*hashunpackstring*/
02226 
02227 
02228 static boolean hashpackdata (handlestream *s, void *pdata, long ctbytes, long *ix) {
02229     
02230     unsigned long x = ctbytes;
02231 
02232     *ix = (*s).pos; /*where the text item is stored*/
02233     
02234     memtodisklong (x);
02235 
02236     if (!writehandlestream (s, &x, sizeof (x)))
02237         return (false);
02238     
02239     return (writehandlestream (s, pdata, ctbytes)); /*following the 4-byte length is the data*/
02240     } /*hashpackdata*/
02241             
02242 
02243 static boolean hashpackbinary (handlestream *s, Handle hbinary, long *ix) {
02244     
02245     unsigned long ctbytes;
02246     
02247     *ix = (*s).pos; /*where the text item is stored*/
02248     
02249     ctbytes = gethandlesize (hbinary); /*first 4 bytes holds the unsigned length*/
02250 
02251     memtodisklong (ctbytes);
02252 
02253     if (!writehandlestream (s, &ctbytes, sizeof (ctbytes)))
02254         return (false);
02255     
02256     return (writehandlestreamhandle (s, hbinary)); /*following the 4-byte length is the packed text*/
02257     } /*hashpackbinary*/
02258 
02259 
02260 static boolean hashunpackbinary (Handle hget, Handle *hbinary, long ix) {
02261     
02262     long ctbytes;
02263     
02264     if (!loadlongfromdiskhandle (hget, &ix, &ctbytes))
02265         return (false);
02266 
02267     return (loadfromhandletohandle (hget, &ix, ctbytes, false, hbinary));
02268     } /*hashunpackbinary*/
02269 
02270 
02271 static boolean hashpackscalar (handlestream *s, hdlhashnode hnode, long *ix) {
02272     
02273     /*
02274     4.0.2b1 dmb: new code for disk-based scalars. for "binary" values above 
02275     a certain size, we allocated a separate db block and pack the address into 
02276     the table data structure instead of the data itself. see the comment in 
02277     hashunpackscalar for a discussion of how this is handled at the other 
02278     end (reading).
02279     
02280     5.1.5b9 dmb: use new hexternalpackdatabase for diskvals
02281     */
02282     
02283     tydiskvaluerecord diskvalue;
02284     Handle hbinary = (**hnode).val.data.binaryvalue;
02285     unsigned long ctbytes;
02286     boolean fl;
02287     
02288     *ix = (*s).pos; /*where the item is stored*/
02289     
02290     if ((**hnode).val.fldiskval) {  /*already a disk-based scalar. can be tricky*/
02291         
02292         if (flexternalmemorypack) {
02293             
02294             hdldatabaserecord hdb = hexternalpackdatabase;
02295             
02296             if (hdb)
02297                 dbpushdatabase (hdb);
02298             
02299             fl = dbrefhandle ((dbaddress) hbinary, &hbinary);
02300             
02301             if (hdb)
02302                 dbpopdatabase ();
02303             
02304             if (!fl)
02305                 return (false);
02306             
02307             fl = hashpackbinary (s, hbinary, ix);
02308             
02309             disposehandle (hbinary); /*we just loaded it to pack; don't change in-memory value*/
02310             
02311             return (fl);
02312             }
02313         
02314         diskvalue.sizeflag = conditionallongswap(diskvalsizeflag);
02315         
02316         diskvalue.adr = (dbaddress) hbinary;
02317         
02318         if (fldatabasesaveas) {
02319         
02320             if (!dbcopy (diskvalue.adr, &diskvalue.adr))
02321                 return (false);
02322             }
02323         
02324         memtodisklong (diskvalue.adr);
02325 
02326         return (writehandlestream (s, &diskvalue, sizeof (diskvalue)));
02327         }
02328     
02329     ctbytes = gethandlesize (hbinary); /*first 4 bytes holds the unsigned length*/
02330     
02331     if ((ctbytes > maxinlinescalarsize) && (!flexternalmemorypack)) {   
02332         
02333         diskvalue.sizeflag = conditionallongswap(diskvalsizeflag);
02334         
02335         diskvalue.adr = nildbaddress;
02336         
02337         if (!dbassignhandle (hbinary, &diskvalue.adr))
02338             return (false);
02339         
02340         if (!fldatabasesaveas) { /*must keep all data structures in sync*/
02341         
02342             disposevaluerecord ((**hnode).val, true);
02343             
02344             (**hnode).val.fldiskval = true;
02345             
02346             (**hnode).val.data.diskvalue = diskvalue.adr;
02347             }
02348         
02349         memtodisklong (diskvalue.adr);
02350 
02351         return (writehandlestream (s, &diskvalue, sizeof (diskvalue)));
02352         }
02353     else {
02354 
02355         memtodisklong (ctbytes);
02356 
02357         if (!writehandlestream (s, &ctbytes, sizeof (ctbytes)))
02358             return (false);
02359         
02360         return (writehandlestreamhandle (s, hbinary)); /*following the 4-byte length is the packed text*/
02361         }
02362     } /*hashpackscalar*/
02363 
02364 
02365 static boolean hashunpackscalar (Handle hget, tyvaluerecord *val, long ix) {
02366     
02367     /*
02368     4.0.2b1 dmb: like langunpackbinary, but this version handles scalar values  
02369     that have had their own db block allocated instead of being packed inline 
02370     in the table data. if the binary block length is diskvalsizeflag (-1), the  
02371     next 4 bytes are the db address of the actual data.
02372     
02373     for such "disk-based" values, the valuerecord has the true tyvaluetype, but the 
02374     fl.diskval flag is set, and the valuedata is a dbaddress. once someone actually 
02375     refers to the data, it is loaded into memory*. to ensure full compatibility with 
02376     all language functions, we must make the valuerecord look totally normal at that 
02377     point, so there's no way that an indirect data structure can be used to preserve
02378     the original dbaddress. so we must release the dbaddress and reallocate the value
02379     when we save.
02380     
02381     if we added more indirection to the data structure -- more like tyexternalvalues -- 
02382     it would no longer be so easy to confine these change to this file. there would be 
02383     additional overhead in accessing large binary values. and for values that change
02384     after being accessed, nothing would be gained; in both cases the original dbaddress
02385     would be released and a new one allocated.
02386     
02387     it should be noted that if we did create an addition data structure for 
02388     indirection, values referenced on a read-only basis would no longer have to be 
02389     rewritten to disk each save. to do this, copyvaluerecord would have to convert 
02390     diskvalues to normal scalars. other language functions that directly modify the value  
02391     of a hashnode would require additional work, like s[3] = 'x' where s is a string. 
02392     it's unclear what other ramifications would surface
02393     
02394     *see hashresolvevalue
02395     
02396     */
02397     
02398     long ctbytes;
02399     
02400     if (!loadlongfromdiskhandle (hget, &ix, &ctbytes))
02401         return (false);
02402     
02403     if (ctbytes == diskvalsizeflag) {
02404         
02405         (*val).fldiskval = true;
02406         
02407         return (loadlongfromdiskhandle (hget, &ix, (dbaddress *) &(*val).data.binaryvalue));
02408         }
02409     else {
02410         return (loadfromhandletohandle (hget, &ix, ctbytes, false, &(*val).data.binaryvalue));
02411         }
02412     } /*hashunpackscalar*/
02413 
02414 
02415 static boolean hashpackexternal (handlestream *s, hdlexternalvariable h, long *ix, boolean *flnewdbaddress) {
02416     
02417     Handle hpacked;
02418     unsigned long ctbytes;
02419     boolean fl;
02420     
02421     *ix = (*s).pos; /*where the text item is stored*/
02422     
02423     if (flexternalmemorypack)
02424         fl = langexternalmemorypack (h, &hpacked, HNoNode);
02425     else
02426         fl = langexternalpack (h, &hpacked, flnewdbaddress);
02427     
02428     if (!fl)
02429         return (false);
02430     
02431     ctbytes = gethandlesize (hpacked); /*first 4 bytes holds the unsigned length*/
02432     
02433     memtodisklong (ctbytes);
02434 
02435     if (!writehandlestream (s, &ctbytes, sizeof (ctbytes)))
02436         goto error;
02437     
02438     if (!writehandlestreamhandle (s, hpacked)) /*following the 4-byte length is the packed text*/
02439         goto error;
02440     
02441     disposehandle (hpacked);
02442     
02443     return (true);
02444     
02445     error:
02446     
02447     disposehandle (hpacked);
02448     
02449     return (false);
02450     } /*hashpackexternal*/
02451 
02452 
02453 static boolean hashunpackexternal (Handle hget, boolean flmemory, hdlexternalhandle *h, long ix) {
02454     
02455     long ctbytes;
02456     Handle hpacked;
02457     boolean fl;
02458     
02459     if (!loadlongfromdiskhandle (hget, &ix, &ctbytes))
02460         return (false);
02461     
02462     if (!loadfromhandletohandle (hget, &ix, ctbytes, true, &hpacked)) 
02463         return (false);
02464     
02465     if (flmemory)
02466         fl = langexternalmemoryunpack (hpacked, h);
02467     else
02468         fl = langexternalunpack (hpacked, h);
02469     
02470     disposehandle (hpacked);
02471     
02472     return (fl);
02473     } /*hashunpackexternal*/
02474 
02475 
02476 static void hashreporterror (short iderror, bigstring bsname, bigstring bserror) {
02477 
02478     /*
02479     5.1.4 dmb: embellish the bserror, folding it and bsname into the message iderror
02480     
02481     the smart part: for recursion, see if bserror already includes iderror. In that
02482     case, fold bsname into the path that's already in the message
02483     */
02484         
02485     bigstring bs;
02486     
02487     fllangerror = false; // make sure our error won't be ignored
02488     
02489     getstringlist (langerrorlist, iderror, bs);
02490     
02491     nthword (bs, 1, '^', bs);
02492     
02493     if (patternmatch (bs, bserror) == 1) { // it's already been parsed in
02494         
02495         pushchar ('.', bsname);
02496         
02497         midinsertstring (bsname, bserror, stringlength (bs) + 1);
02498         
02499         langerrormessage (bserror);
02500         }
02501     else
02502         lang2paramerror (iderror, bsname, bserror);
02503     } /*hashbuilderrormessage*/
02504 
02505 
02506 typedef struct typackinforecord {
02507 
02508     handlestream s1;
02509     handlestream s2;
02510     boolean flmustsave;
02511     } typackinforecord;
02512 
02513 
02514 static boolean hashpackvisit (bigstring bsname, hdlhashnode hnode, tyvaluerecord val, ptrvoid refcon) {
02515     
02516     /*
02517     return true to terminate the search, false to continue.
02518     
02519     4/8/93 dmb: added support for code values
02520     
02521     2.1b2 dmb: filespecs must be saved as aliases since volume reference 
02522     numbers aren't persistent across boots
02523     
02524     3.0.2 dmb: power pc code for doubles
02525     
02526     3.0.2 dmb: fixed memory leak when packing filespecs and code
02527     
02528     3.0.4 dmb: must set rec.data.longvalue for PPC doublevaluetype! fixes db corruption.
02529 
02530     5.1b21 dmb: don't let unresolvable address kill the save
02531     
02532     5.1.3 dmb: smarter error reporting
02533     
02534     6.2a15 AR: added flmustsave parameter
02535     */
02536     
02537     typackinforecord *lpi = (typackinforecord *) refcon;
02538     tydisksymbolrecord rec;
02539     bigstring bsvalue;
02540     long size;
02541     Handle hpacked;
02542     langerrormessagecallback savecallback;
02543     ptrvoid saverefcon;
02544     bigstring bspackerror;
02545     boolean fl;
02546     
02547     assert (sizeof (tydisksymbolrecord) == 10L);
02548     
02549     /*
02550     if (stringlength (bsname) == 0)
02551         Debugger ();
02552     
02553     ccmsg (bsname, false);
02554     */
02555     
02556     if ((**hnode).fldontsave && !flexternalmemorypack) /*keep traversing the table*/
02557         return (false);
02558     
02559     langtraperrors (bspackerror, &savecallback, &saverefcon);
02560     
02561     clearbytes (&rec, sizeof (rec));
02562     
02563     if (!hashpackstring (&lpi->s2, bsname, &rec.ixkey))
02564         goto error;
02565     
02566     memtodisklong (rec.ixkey);
02567     
02568 //  rec.valuetype = conditionalenumswap(val.valuetype);
02569     rec.valuetype = val.valuetype;
02570     
02571     rec.data = val.data;
02572     
02573     size = sizeof (long); // default size of value data
02574     
02575     switch (val.valuetype) {
02576         
02577         case oldstringvaluetype:
02578             copyheapstring ((hdlstring) val.data.stringvalue, bsvalue);
02579             
02580             if (!hashpackstring (&lpi->s2, bsvalue, &rec.data.longvalue))
02581                 goto error;
02582             
02583             break;
02584         
02585         case addressvaluetype:
02586             disablelangerror ();
02587 
02588             fl = getaddresspath (val, bsvalue);
02589             
02590             enablelangerror ();
02591             
02592             if (!fl) // on error, bsvalue should at least be item's name; don't break the save
02593                 ;
02594             
02595             if (!hashpackstring (&lpi->s2, bsvalue, &rec.data.longvalue))
02596                 goto error;
02597             
02598             break;
02599         
02600     #ifdef oldMACVERSION    
02601         case filespecvaluetype: { /*need to save as a (minimal) alias*/
02602             
02603             register hdlfilespec x = val.data.filespecvalue;
02604             tyfilespec fs = **x;
02605             AliasHandle halias = nil;
02606             
02607             disablelangerror ();
02608             
02609             if (filespectoalias (&fs, true, &halias)) {
02610                 
02611                 rec.version = 1; /*all versions were zero until now*/
02612                 
02613                 x = (hdlfilespec) halias;
02614                 }
02615                 
02616             enablelangerror ();
02617             
02618             if (!hashpackbinary (&lpi->s2, (Handle) x, &rec.data.longvalue))
02619                 goto error;
02620             
02621             disposehandle ((Handle) halias); /*3.0.2*/
02622             
02623             break;
02624             }
02625     #endif
02626     
02627         case rectvaluetype: {
02628             diskrect rdisk;
02629             
02630             recttodiskrect (*val.data.rectvalue, &rdisk);
02631             
02632             if (!hashpackdata (&lpi->s2, &rdisk, sizeof (rdisk), &rec.data.longvalue))
02633                 goto error;
02634             
02635             break;
02636             }
02637         
02638         case rgbvaluetype: {
02639             diskrgb rgbdisk;
02640             
02641             rgbtodiskrgb (*val.data.rgbvalue, &rgbdisk);
02642             
02643             if (!hashpackdata (&lpi->s2, &rgbdisk, sizeof (rgbdisk), &rec.data.longvalue))
02644                 goto error;
02645             
02646             break;
02647             }
02648         
02649         #if noextended
02650         
02651             case doublevaluetype: {
02652                 double x = **val.data.doublevalue;
02653                 extended80 x80;
02654                 
02655                 #ifdef WIN95VERSION
02656                     convertToMacExtended (x, &x80);
02657                 #else
02658                     dtox80 (&x, &x80);
02659                 #endif  
02660                 
02661                 if (!hashpackdata (&lpi->s2, &x80, sizeof (x80), &rec.data.longvalue))
02662                     goto error;
02663                 
02664                 break;
02665                 }
02666         #else
02667         
02668             case doublevaluetype:
02669             
02670         #endif
02671         
02672     #ifdef oldWIN95VERSION  
02673         case filespecvaluetype:
02674         case aliasvaluetype:
02675     #endif
02676         case stringvaluetype:
02677         case passwordvaluetype:
02678         case patternvaluetype:
02679         case objspecvaluetype:
02680         case binaryvaluetype:
02681     #ifndef oplanglists
02682         case listvaluetype:
02683         case recordvaluetype:
02684     #endif
02685             if (!hashpackscalar (&lpi->s2, hnode, &rec.data.longvalue))
02686                 goto error;
02687                 
02688             break;
02689         
02690     #ifdef oplanglists
02691         case listvaluetype:
02692         case recordvaluetype:
02693             if (!oppacklist (val.data.listvalue, &hpacked))
02694                 goto error;
02695             
02696             if (!hashpackbinary (&lpi->s2, hpacked, &rec.data.longvalue))
02697                 goto error;
02698             
02699             rec.version = 2;
02700             
02701             disposehandle (hpacked);
02702 
02703             break;
02704     #endif
02705 
02706     #ifdef version5orgreater
02707         case filespecvaluetype:
02708         case aliasvaluetype:
02709             if (!langpackfileval (&val, &hpacked))
02710                 goto error;
02711             
02712             if (!hashpackbinary (&lpi->s2, hpacked, &rec.data.longvalue))
02713                 goto error;
02714             
02715             rec.version = 2;
02716             
02717             disposehandle (hpacked);
02718             
02719             break;
02720     #endif
02721 
02722         case codevaluetype:
02723             if (!langpacktree (val.data.codevalue, &hpacked))
02724                 goto error;
02725             
02726             if (!hashpackbinary (&lpi->s2, hpacked, &rec.data.longvalue))
02727                 goto error;
02728             
02729             disposehandle (hpacked); /*3.0.2*/
02730             
02731             break;
02732         
02733         case externalvaluetype: {
02734             boolean flnewdbaddress = false;
02735             
02736             if (!hashpackexternal (&lpi->s2, (hdlexternalvariable) val.data.externalvalue, &rec.data.longvalue, &flnewdbaddress))
02737                 goto error;
02738             
02739             lpi->flmustsave = lpi->flmustsave || flnewdbaddress;
02740                 
02741             break;
02742             }
02743             
02744         case novaluetype:
02745         case booleanvaluetype:
02746         case charvaluetype:
02747             size = sizeof (char);
02748             
02749             break;
02750         
02751         case intvaluetype:
02752         case tokenvaluetype:
02753             size = sizeof (short);
02754             
02755             break;
02756         
02757         case pointvaluetype:
02758             memtodiskshort (val.data.pointvalue.h);
02759             memtodiskshort (val.data.pointvalue.v);
02760             
02761             size = 0;
02762             
02763             break;
02764             
02765         case longvaluetype:
02766         case ostypevaluetype:
02767         case enumvaluetype:
02768         case fixedvaluetype:
02769         case singlevaluetype:
02770             size = sizeof (long);
02771             
02772             break;
02773         
02774         case directionvaluetype:
02775             size = sizeof (rec.data.dirvalue); // not necessarily a tydirection
02776             
02777             break;
02778         
02779         case datevaluetype: // *** needs xplat format
02780             size = sizeof (long);
02781             
02782             break;
02783         
02784         default:
02785             langerror (cantpackerror);
02786             
02787             goto error;
02788         } /*switch*/
02789     
02790     if (size == sizeof (long))
02791         memtodisklong (rec.data.longvalue);
02792     
02793     if (size == sizeof (short))
02794         memtodiskshort (rec.data.intvalue);
02795     
02796     if (!writehandlestream (&lpi->s1, &rec, sizeof (rec))) 
02797         goto error;
02798     
02799     languntraperrors (savecallback, saverefcon, false);
02800     
02801     return (false); /*keep going, kind of backwards…*/
02802     
02803     error:
02804     
02805     disposehandlestream (&lpi->s1); 
02806     
02807     disposehandlestream (&lpi->s2); 
02808     
02809     languntraperrors (savecallback, saverefcon, true);
02810     
02811     hashreporterror (hashpackerror, bsname, bspackerror);
02812     
02813     return (true); /*stop now, this is the error return*/
02814     } /*hashpackvisit*/
02815 
02816 
02817 boolean hashpacktable (hdlhashtable htable, boolean flmemory, Handle *hpackedtable, boolean *flmustsave) {
02818     
02819     /*
02820     traverse the current symbol table, creating two packages of information
02821     that can be unpacked back into an in-memory hash table.
02822     
02823     the first, hrecords, is an array of disksymbolrecords.  each record can
02824     have one or two indexes to strings in the hstrings package.
02825     
02826     then merge the two handles returning one packet for the caller to save.
02827     
02828     10/6/91 dmb: mergehandles now consumes both source handles
02829     
02830     2/2/93 dmb: check result of pushpackstack
02831     
02832     3/30/93 dmb: 
02833     */
02834     
02835     register boolean fl = false;
02836     tydisktablerecord header;
02837     typackinforecord packrec;
02838     Handle h1, h2;
02839     
02840     clearbytes (&header, sizeof (header));
02841     
02842     header.version = conditionalshortswap(tablediskversion);
02843     
02844     header.timecreated = conditionallongswap((**htable).timecreated);
02845     
02846     header.timelastsave = conditionallongswap((**htable).timelastsave);
02847     
02848     header.sortorder = conditionalshortswap((**htable).sortorder);
02849     
02850     #ifdef xmlfeatures
02851         if ((**htable).flxml)
02852             header.flags |= flxml;
02853     #endif
02854     
02855     clearbytes (&packrec, sizeof (packrec));
02856     
02857     packrec.flmustsave = *flmustsave;
02858 
02859     openhandlestream (nil, &packrec.s1);
02860 
02861     openhandlestream (nil, &packrec.s2);
02862 
02863     if (!writehandlestream (&packrec.s1, &header, sizeof (header)))
02864         goto exit;
02865     
02866     flexternalmemorypack = flmemory;
02867     
02868     if (flexternalmemorypack)
02869         hexternalpackdatabase = tablegetdatabase (htable);
02870     
02871     hashsortedinversesearch (htable, &hashpackvisit, &packrec);
02872     
02873     if (packrec.s1.data == nil) /*an error while packing*/
02874         goto exit;
02875 
02876     h1 = closehandlestream (&packrec.s1);
02877 
02878     h2 = closehandlestream (&packrec.s2);
02879     
02880     fl = mergehandles (h1, h2, hpackedtable);
02881     
02882     *flmustsave = packrec.flmustsave;
02883 
02884     exit:
02885 
02886     return (fl);
02887     } /*hashpacktable*/
02888 
02889 
02890 boolean hashunpacktable (Handle hpackedtable, boolean flmemory, hdlhashtable htable) {
02891     
02892     /*
02893     unpack a hashtable packed by hashpacktable.  first explode the packed handle
02894     into two handles.
02895     
02896     return true if everything worked.
02897     
02898     we dispose of the packed table as soon as we're finished with it and both
02899     of the exploded handles.
02900     
02901     9/30/91 dmb: changed all hashassign calls to hashinsert; we're starting with 
02902     a fresh table, so duplicate names should only exist if they were saved that 
02903     way, in which case we want to preserve them.
02904     
02905     3/2/92 dmb: added backward compat code for change in double type (1.0 used 
02906     "universal" extended doubles; now we use SANE extended
02907     
02908     8/14/92 dmb: added special case for nil objspecs
02909     
02910     4/8/93 dmb: added support for code values
02911     
02912     2.1b2 dmb: filespecs are now saved as aliases
02913     
02914     2.1b9 dmb: if filespec can't be resolved from stored alias, change 
02915     valuetype to alias. also, this operation no longer attempts to mount 
02916     volumes
02917     
02918     5.0d1 dmb: tables now have a header when packed
02919     
02920     5.0.2b6 dmb: use new sethashtable to remove stack depth limit
02921     
02922     5.1.4 dmb: use new hashreporterror
02923 
02924     2002-11-11 AR: Added assert to make sure the C compiler chose the
02925     proper byte alignment for the tydisktablerecord struct. If it did not,
02926     we would end up corrupting any database files we saved.
02927     
02928     2006-04-20 sethdill & aradke: convert rgb values to native byte order
02929     */
02930     
02931     boolean fl;
02932     Handle hrecords, hstrings;
02933     bigstring bsname, bsvalue;
02934     hdlhashnode hlastnode = nil;
02935     boolean flsorted = true; // 6.10.97 dmb: no longer do any auto-sorting here
02936     tydisktablerecord header;
02937     long ix = 0;
02938     long ixstrings;
02939     long size;
02940     Handle hpacked;
02941     boolean fldirty;
02942     langerrormessagecallback savecallback;
02943     ptrvoid saverefcon;
02944     bigstring bsunpackerror;
02945     hdlhashtable prevhashtable;
02946     
02947     assert (sizeof(tydisktablerecord) == 16L);
02948     
02949     if (!unmergehandles (hpackedtable, &hrecords, &hstrings)) /*consumes hpackedtable*/
02950         return (false);
02951     
02952     fldirty = (**htable).fldirty; //start with current state
02953     
02954     /*see if this is a 5.0 table, with a header*/
02955     
02956     loadfromhandle (hrecords, &ix, sizeof (tydisktablerecord), &header);
02957     
02958     header.version = conditionalshortswap(header.version);
02959     
02960     if (header.version > 0) { // a header has been written
02961         
02962         (**htable).sortorder = conditionalshortswap(header.sortorder);
02963         
02964         (**htable).timecreated = conditionallongswap(header.timecreated);
02965         
02966         (**htable).timelastsave = conditionallongswap(header.timelastsave);
02967         
02968         if (header.version == 2) //5.0.1: forgot to initialize flags
02969             header.flags = 0;
02970         
02971         flsorted = true;
02972         }
02973     else {
02974         header.version = 0;
02975         
02976         header.flags = 0;
02977         
02978         (**htable).timecreated = (**htable).timelastsave = timenow (); //5.0.1
02979         
02980         ix = 0;
02981         }
02982     
02983     fl = false; /*default return value*/
02984     
02985     #ifdef xmlfeatures
02986         (**htable).flxml = (header.flags & flxml) != 0;
02987     #endif
02988 
02989     prevhashtable = sethashtable (htable); // pushhashtable (htable);
02990     
02991     ++flunpackingtable;
02992     
02993     langtraperrors (bsunpackerror, &savecallback, &saverefcon); // hook errors so we can embellish
02994     
02995     while (true) {
02996         
02997         tydisksymbolrecord rec;
02998         tyvaluerecord val;
02999         
03000         assert (sizeof (tydisksymbolrecord) == sizeof (tyOLD42disksymbolrecord));
03001         
03002     #if 0 //def MACVERSION
03003         tyOLD42disksymbolrecord rec42;
03004         
03005         if (header.version < 2) {
03006             
03007             if (!loadfromhandle (hrecords, &ix, sizeof (rec42), &rec42))
03008                 break;
03009             
03010             rec.ixkey = rec42.ixkey;
03011             rec.valuetype = rec42.valuetype;
03012             rec.version = rec42.version;
03013             rec.data.longvalue = rec42.data.longvalue;
03014             }
03015         else
03016     #endif
03017             
03018             if (!loadfromhandle (hrecords, &ix, sizeof (rec), &rec)) /*out of records*/
03019                 break;
03020         
03021         disktomemlong (rec.ixkey);
03022 //      disktomemshort (rec.valuetype);
03023 //      disktomemshort (rec.version);
03024         
03025         if (header.version < 2) // shift down from old bitfield position
03026             rec.version >>= 4;
03027 
03028         ixstrings = conditionallongswap  (rec.data.longvalue);
03029         
03030         hashunpackstring (hstrings, bsname, rec.ixkey);
03031         
03032         if (isemptystring (bsname)) /*skip junk*/
03033             continue;
03034         
03035         initvalue (&val, (tyvaluetype) rec.valuetype);
03036         
03037         size = 0; // by default, we take no data directly from rec
03038         
03039         switch (val.valuetype) {
03040             
03041             case oldstringvaluetype:
03042                 hashunpackstring (hstrings, bsvalue, ixstrings);
03043                 
03044                 if (!newheapvalue (bsvalue + 1, (long) stringlength (bsvalue), stringvaluetype, &val))
03045                     goto L1;
03046                 
03047                 exemptfromtmpstack (&val);
03048                 
03049                 break;
03050             
03051             case addressvaluetype:
03052                 hashunpackstring (hstrings, bsvalue, ixstrings);
03053                 
03054                 if (!hashinsertaddress (bsname, bsvalue))
03055                     goto L1;
03056                 
03057                 setemptystring (bsname); /*exception -- we've already inserted it*/
03058                 
03059                 break;
03060             
03061             case olddoublevaluetype: {
03062                 Handle hextended;
03063                 
03064                 if (!hashunpackbinary (hstrings, &hextended, ixstrings))
03065                     goto L1;
03066                 
03067                 pullfromhandle (hextended, 2, 2, nil); /*universal -> SANE*/
03068                 
03069                 val.valuetype = doublevaluetype;
03070                 
03071                 val.data.binaryvalue = hextended;
03072                 
03073                 break;
03074                 }
03075             
03076         #ifdef oldMACVERSION
03077             case filespecvaluetype: { /*need to save as a (minimal) alias*/
03078                 tyfilespec fs;
03079                 boolean flresolved;
03080                 Handle hbinary;
03081                 
03082                 if (!hashunpackbinary (hstrings, &hbinary, ixstrings))
03083                     goto L1;
03084                 
03085                 if (rec.version > 0) { /*filespec is stored as an alias*/
03086                     
03087                     disablelangerror ();
03088                     
03089                     flresolved = aliastofilespec ((AliasHandle) hbinary, &fs);
03090                     
03091                     enablelangerror ();
03092                     
03093                     if (flresolved) {
03094                         
03095                         if (!sethandlecontents (&fs, filespecsize (fs), hbinary))
03096                             goto L1;
03097                         }
03098                     else
03099                         val.valuetype = aliasvaluetype;
03100                     }
03101                 
03102                 val.data.binaryvalue = hbinary;
03103                 
03104                 break;
03105                 }
03106             #endif
03107             
03108             case rectvaluetype: {
03109                 diskrect **rdisk;
03110                 Rect r;
03111                  
03112                 if (!hashunpackbinary (hstrings, (Handle *) &rdisk, ixstrings))
03113                     goto L1;
03114                 
03115                 diskrecttorect (*rdisk, &r);
03116                 
03117                 disposehandle ((Handle) rdisk);
03118                 
03119                 if (!newheapvalue (&r, sizeof (r), rectvaluetype, &val))
03120                     goto L1;
03121                 
03122                 exemptfromtmpstack (&val);
03123                 
03124                 break;
03125                 }
03126             
03127             case rgbvaluetype: { /* 2006-04-20 sethdill & aradke */
03128                 diskrgb **rgbdisk;
03129                 RGBColor rgb;
03130                  
03131                 if (!hashunpackbinary (hstrings, (Handle *) &rgbdisk, ixstrings))
03132                     goto L1;
03133                 
03134                 diskrgbtorgb (*rgbdisk, &rgb);
03135                 
03136                 disposehandle ((Handle) rgbdisk);
03137                 
03138                 if (!newheapvalue (&rgb, sizeof (rgb), rgbvaluetype, &val))
03139                     goto L1;
03140                 
03141                 exemptfromtmpstack (&val);
03142                 
03143                 break;
03144                 }
03145                 
03146         #if noextended
03147         
03148             case doublevaluetype: {
03149                 double x;
03150                 extended80 **x80;
03151                  
03152                 if (!hashunpackbinary (hstrings, (Handle *) &x80, ixstrings))
03153                     goto L1;
03154                 
03155                 #ifdef WIN95VERSION
03156                     convertFromMacExtended (&x, *x80);
03157                 #else
03158                     x = x80tod (*x80);
03159                 #endif           
03160                  
03161                 disposehandle ((Handle) x80);   // 1/22/97 dmb: this was a leak!
03162                 
03163                 if (!setdoublevalue (x, &val))
03164                     goto L1;
03165                 
03166                 exemptfromtmpstack (&val);
03167             
03168                 break;
03169                 }
03170         #else
03171         
03172             case doublevaluetype:
03173             
03174         #endif
03175         
03176         #if oldWIN95VERSION 
03177             case filespecvaluetype: // unpack normally
03178             case aliasvaluetype:    // *** needs xplat format
03179         #endif
03180             case stringvaluetype:
03181             case passwordvaluetype:
03182             case patternvaluetype:
03183         #ifndef oplanglists
03184             case listvaluetype:
03185             case recordvaluetype:
03186         #endif
03187             case binaryvaluetype: {
03188                 if (!hashunpackscalar (hstrings, &val, ixstrings))
03189                     goto L1;
03190                 
03191                 break;
03192                 }
03193             
03194         #ifdef oplanglists
03195             case listvaluetype:
03196             case recordvaluetype:
03197                 if (rec.version < 2) {
03198                     #ifdef MACVERSION
03199                         AEDesc aelist;
03200                         
03201                         if (!hashunpackscalar (hstrings, &val, ixstrings))
03202                             goto L1;
03203                         
03204                         if (val.fldiskval) { //yikes! we have to resolve before converting
03205                             Handle hbinary;
03206                             
03207                             if (!dbrefhandle (val.data.diskvalue, &hbinary))
03208                                 goto L1;
03209                             
03210                             dbpushreleasestack (val.data.diskvalue, val.valuetype);
03211                             
03212                             fldirty = true; //table needs to be rewritten
03213                             
03214                             val.data.binaryvalue = hbinary;
03215                             
03216                             val.fldiskval = false;
03217                             }
03218                         
03219                         #if TARGET_API_MAC_CARBON == 1 /*PBS 03/14/02: AE OS X fix.*/
03220                             
03221                             {
03222                             DescType typecode = typeAEList;
03223                             
03224                             if (val.valuetype == recordvaluetype)
03225                                 typecode = typeAERecord;
03226                         
03227                             newdescwithhandle (&aelist, typecode, val.data.binaryvalue);
03228                             }
03229                         
03230                         #else
03231                                 
03232                             if (val.valuetype == recordvaluetype)
03233                                 aelist.descriptorType = typeAERecord;
03234                             else
03235                                 aelist.descriptorType = typeAEList;
03236                     
03237                             aelist.dataHandle = val.data.binaryvalue;
03238                         
03239                         #endif
03240                         
03241                         if (!langipcconvertaelist (&aelist, &val))
03242                             goto L1;
03243                         
03244                         AEDisposeDesc (&aelist);
03245                         
03246                         exemptfromtmpstack (&val);
03247                     #endif
03248                     
03249                     #ifdef WIN95VERSION
03250                         val.valuetype = stringvaluetype;
03251                         
03252                         newheapstring ("\x15" "***unreadable data***", &val.data.stringvalue);
03253                     #endif
03254                     
03255                     break;
03256                     }
03257                 
03258                 if (!hashunpackbinary (hstrings, &hpacked, ixstrings))
03259                     goto L1;
03260                 
03261                 if (!opunpacklist (hpacked, &val.data.listvalue))
03262                     goto L1;
03263                 
03264                 break;
03265         #endif
03266 
03267         #ifdef version5orgreater
03268             case filespecvaluetype:
03269             case aliasvaluetype:
03270 
03271                 if (rec.version < 2) {
03272                     #ifdef MACVERSION
03273                         tyfilespec fs;
03274                         boolean flresolved;
03275                         Handle hbinary;
03276                         
03277                         if (!hashunpackbinary (hstrings, &hbinary, ixstrings))
03278                             goto L1;
03279                         
03280                         if (rec.version > 0) { /*filespec is stored as an alias*/
03281                             
03282                             disablelangerror ();
03283                             
03284                             flresolved = aliastofilespec ((AliasHandle) hbinary, &fs);
03285                             
03286                             enablelangerror ();
03287                             
03288                             if (flresolved) {
03289                                 
03290                                 if (!sethandlecontents (&fs, filespecsize (fs), hbinary))
03291                                     goto L1;
03292                                 }
03293                             else
03294                                 val.valuetype = aliasvaluetype;
03295                             }
03296                         
03297                         val.data.binaryvalue = hbinary;
03298                         
03299                         break;
03300                     #endif
03301                     
03302                     #ifdef WIN95VERSION
03303                         if (!hashunpackscalar (hstrings, &val, ixstrings))
03304                             goto L1;
03305                         
03306                         break;
03307                     #endif
03308                     }
03309                 
03310                 if (!hashunpackbinary (hstrings, &hpacked, ixstrings))
03311                     goto L1;
03312                 
03313                 if (!langunpackfileval (hpacked, &val))
03314                     goto L1;
03315                 
03316                 break;
03317         #endif
03318 
03319             case objspecvaluetype: {
03320                 Handle hobjspec;
03321                 
03322                 if (!hashunpackbinary (hstrings, &hobjspec, ixstrings))
03323                     goto L1;
03324                 
03325                 if (gethandlesize (hobjspec) == 0) {
03326                     
03327                     disposehandle (hobjspec);
03328                     
03329                     hobjspec = nil;
03330                     }
03331                 
03332                 val.data.objspecvalue = hobjspec;
03333                 
03334                 break;
03335                 }
03336             
03337             case codevaluetype:
03338                 if (!hashunpackbinary (hstrings, &hpacked, ixstrings))
03339                     goto L1;
03340                 
03341                 if (!langunpacktree (hpacked, &val.data.codevalue))
03342                     goto L1;
03343                 
03344                 break;
03345             
03346             case externalvaluetype: {
03347                 hdlexternalhandle h;
03348                 
03349                 if (!hashunpackexternal (hstrings, flmemory, &h, ixstrings))
03350                     goto L1;
03351                 
03352                 val.data.externalvalue = (Handle) h;
03353                 
03354                 break;
03355                 }
03356                 
03357             case directionvaluetype:
03358                 #ifdef WIN95VERSION
03359                 val.data.dirvalue = 0;  // clear both bytes before loading low byte
03360                 #endif
03361 
03362             case booleanvaluetype:
03363                 if (header.version < 2)
03364                     rec.data.chvalue = (byte) rec.data.intvalue;
03365                 // fall through
03366             case novaluetype:
03367             case charvaluetype:
03368                 val.data.chvalue = rec.data.chvalue;
03369                 
03370                 break;
03371             
03372             case intvaluetype:
03373             case tokenvaluetype:
03374                 val.data.intvalue = rec.data.intvalue;
03375                 
03376                 disktomemshort (val.data.intvalue); // 5.0b9 dmb: was flipping rec.data
03377                 break;
03378             
03379             case pointvaluetype:
03380                 val.data.pointvalue = rec.data.pointvalue;
03381                 
03382                 disktomemshort (val.data.pointvalue.h);
03383                 disktomemshort (val.data.pointvalue.v);
03384                 
03385                 break;
03386                 
03387             case longvaluetype:
03388             case ostypevaluetype:
03389             case enumvaluetype:
03390             case fixedvaluetype:
03391             case singlevaluetype:
03392             case datevaluetype:
03393                 val.data.longvalue = rec.data.longvalue;
03394                 
03395                 disktomemlong (val.data.longvalue);
03396                 
03397                 break;
03398             
03399             default:
03400                 val.data = rec.data;
03401                 
03402                 break;
03403             } /*switch*/
03404         
03405         if (!isemptystring (bsname)) { /*needs to be inserted*/
03406             
03407             if (!hashinsert (bsname, val))
03408                 goto L1;
03409             }
03410         
03411         if (hlastnode == nil)
03412             (**htable).hfirstsort = hnewnode;
03413         else
03414             (**hlastnode).sortedlink = hnewnode;
03415         
03416         hlastnode = hnewnode;
03417         } /*for*/
03418         
03419     fl = true; /*loop terminated, we will return true*/
03420     
03421     L1:
03422     
03423     languntraperrors (savecallback, saverefcon, !fl);
03424     
03425     sethashtable (prevhashtable);
03426     
03427     --flunpackingtable;
03428     
03429     disposehandle (hrecords);
03430     
03431     disposehandle (hstrings);
03432     
03433     (**htable).fldirty = fldirty;
03434     
03435     if (!flsorted)
03436         hashresort (htable, nil);
03437     
03438     if (!fl)
03439         hashreporterror (hashunpackerror, bsname, bsunpackerror);
03440     
03441     return (fl);
03442     } /*hashunpacktable*/
03443 
03444 
03445 boolean hashcountitems (hdlhashtable htable, long *ctitems) {
03446     
03447     /*
03448     return the number of items in the indicated hash table.
03449     */
03450     
03451     register hdlhashnode nomad = (**htable).hfirstsort;
03452     register long ct = 0;
03453     
03454     while (nomad != nil) {
03455         
03456         ct++;
03457         
03458         nomad = (**nomad).sortedlink;
03459         } /*while*/
03460         
03461     *ctitems = ct;
03462     
03463     return (true);
03464     } /*hashcountitems*/
03465 
03466 
03467 boolean hashsortedsearch (hdlhashtable htable, const bigstring bsname, long *item) {
03468     
03469     /*
03470     search the sorted linked list attached to the indicated table, and return the
03471     index of the node having the indicated name.
03472     
03473     return false if there is no node with the name.
03474     
03475     2/6/91 dmb: handle array references
03476     */
03477     
03478     register hdlhashnode nomad = (**htable).hfirstsort;
03479     register long ct = 0;
03480     
03481     /*
03482     short arrayindex;
03483     
03484     if (hashstringtoarrayindex (bsname, &arrayindex)) {
03485         
03486         *item = arrayindex - 1;
03487         
03488         return (true);
03489         }
03490     */
03491     
03492     while (nomad != nil) {
03493         
03494         if (equalidentifiers ((**nomad).hashkey, bsname)) {
03495         
03496             *item = ct;
03497             
03498             return (true);
03499             }
03500         
03501         ct++;
03502         
03503         nomad = (**nomad).sortedlink;
03504         } /*while*/
03505         
03506     return (false);
03507     } /*hashsortedsearch*/
03508     
03509     
03510 boolean hashgetnthnode (hdlhashtable htable, long n, hdlhashnode *hnode) {
03511     
03512     /*
03513     n is 0-based.  we return a handle to the node for the indicated item number.
03514     
03515     9/12/90 DW: add defensive driving -- don't crash when there are zero items in 
03516     the table and the caller is asking for info about item #0.
03517     
03518     4/18/91 dmb: fixed loop's nil test; used to crash when n was just out of range.
03519     */
03520     
03521     register hdlhashnode nomad = (**htable).hfirstsort;
03522     register long ct = n;
03523     
03524     *hnode = nil;
03525     
03526     if (nomad == nil) /*defensive driving*/
03527         return (false);
03528     
03529     while (--ct >= 0) {
03530         
03531         nomad = (**nomad).sortedlink;
03532         
03533         if (nomad == nil) /*there aren't that many items in the table*/
03534             return (false);
03535         } /*for*/
03536     
03537     *hnode = nomad;
03538     
03539     return (true);
03540     } /*hashgetnthnode*/
03541     
03542     
03543 boolean hashgetsortedindex (hdlhashtable htable, hdlhashnode hnode, long *idx) {
03544     
03545     /*
03546     traverse the sorted list for the indicated table, looking for the indicated node.
03547     
03548     if we find it, set *idx to its index, and return true.
03549     
03550     the index is 0-based.
03551     */
03552     
03553     register hdlhashnode nomad = (**htable).hfirstsort;
03554     register long ct = 0;
03555     
03556     while (nomad != nil) {
03557         
03558         if (nomad == hnode) { /*found it*/
03559             
03560             *idx = ct;
03561             
03562             return (true);
03563             }
03564             
03565         nomad = (**nomad).sortedlink;
03566         
03567         ct++;
03568         } /*while*/
03569         
03570     return (false); /*not found*/
03571     } /*hashgetsortedindex*/
03572 
03573 
03574 boolean hashgetiteminfo (hdlhashtable htable, long item, bigstring bsname, tyvaluerecord *val) {
03575     
03576     /*
03577     the item number is 0-based.  we return the name and value information for the
03578     indicated item number, returning false if there aren't that many items.
03579     
03580     4/3/92 dmb: must check for unresolved addresses here
03581     
03582     3/19/93 dmb: if bsname is nil, don't set it
03583     
03584     6/7/96 dmb: if val is nil, don't set it either. (For ODBEngine, but useful elsewhere)
03585     
03586     5.0a23 dmb: don't resolve the value if caller doesn't need it.
03587     */
03588     
03589     hdlhashnode hnode;
03590     
03591     if (!hashgetnthnode (htable, item, &hnode))
03592         return (false);
03593     
03594     if (bsname != nil)
03595         gethashkey (hnode, bsname);
03596     
03597     if (val != nil) {
03598         
03599         if (!hashresolvevalue (htable, hnode))
03600             return (false);
03601         
03602         *val = (**hnode).val;
03603         }
03604     
03605     return (true);
03606     } /*hashgetiteminfo*/
03607     
03608 
03609 #if !odbengine
03610 boolean hashgetvaluestring (tyvaluerecord val, bigstring bs) {
03611     
03612     /*
03613     a special entrypoint for creating a string representation of a value, 
03614     something worth displaying.  you shouldn't put up an error dialog for any 
03615     of these coercions, and it's ok not to replicate all the info in the coercion.
03616     
03617     5/21/91 dmb: copy valuerecord before coercing, or we trash caller's value
03618     
03619     12/22/92 dmb: if an error occurs during string coercion, must clear temps
03620     
03621     2.1b2 dmb: deparse string values
03622     
03623     2.1b4 dmb: don't deparse quotes, just non-printing characters (pass chnul)
03624 
03625     5.0.1 dmb: deparse filespec and alias values
03626     */
03627     
03628     disablelangerror ();
03629     
03630     switch (val.valuetype) {
03631         
03632         case novaluetype:
03633             langgetmiscstring (nilstring, bs);
03634             
03635             break;
03636         
03637         case charvaluetype:
03638             setstringwithchar (val.data.chvalue, bs);
03639             
03640             langdeparsestring (bs, chnul);
03641             
03642             break;
03643         
03644         case booleanvaluetype:
03645         case intvaluetype:
03646         case longvaluetype:
03647         case directionvaluetype:
03648         case datevaluetype:
03649         case ostypevaluetype:
03650         case pointvaluetype:
03651         case rectvaluetype:
03652         case rgbvaluetype:
03653         case patternvaluetype:
03654         case fixedvaluetype:
03655         case singlevaluetype:
03656         case doublevaluetype:
03657         case objspecvaluetype:
03658         case enumvaluetype:
03659         case listvaluetype:
03660         case recordvaluetype:
03661         
03662             if (copyvaluerecord (val, &val) && coercetostring (&val)) {
03663                 
03664                 pullstringvalue (&val, bs);
03665                 
03666                 releaseheaptmp ((Handle) val.data.stringvalue);
03667                 
03668                 break;
03669                 }
03670             
03671             cleartmpstack (); /*clean up on error*/
03672             
03673             langgetmiscstring (errorstring, bs);
03674             
03675             break;
03676         
03677         case filespecvaluetype:
03678         case aliasvaluetype:
03679         
03680             if (copyvaluerecord (val, &val) && coercetostring (&val)) {
03681                 
03682                 pullstringvalue (&val, bs);
03683                 
03684                 releaseheaptmp ((Handle) val.data.stringvalue);
03685 
03686                 langdeparsestring (bs, chnul);
03687                 
03688                 break;
03689                 }
03690             
03691             cleartmpstack (); /*clean up on error*/
03692             
03693             langgetmiscstring (errorstring, bs);
03694             
03695             break;
03696 
03697         case addressvaluetype:
03698             getaddresspath (val, bs);
03699             
03700             if (!isemptystring (bs))
03701                 insertchar ('@', bs);
03702             
03703             break;
03704         
03705         case stringvaluetype:
03706             pullstringvalue (&val, bs);
03707             
03708             langdeparsestring (bs, chnul);
03709             
03710             break;
03711         
03712         case binaryvaluetype: {
03713             register Handle h = val.data.binaryvalue;
03714             long cthex = gethandlesize (h) - sizeof (OSType);
03715             
03716             if (cthex == 0)
03717                 langgetmiscstring (nilstring, bs);
03718             else
03719                 bytestohexstring (*h + sizeof (OSType), cthex, bs);
03720             
03721             /*
03722             OSType typeid;
03723             bigstring bstype, bsdata;
03724             
03725             typeid = **(OSType **) h;
03726             
03727             switch (typeid) {
03728                 
03729                 case 'TEXT':
03730                 case 's255':
03731                     texttostring (*h + sizeof (OSType), gethandlesize (h) - sizeof (OSType), bs);
03732                     
03733                     break;
03734                 
03735                 default:
03736                     bytestohexstring (*h + sizeof (OSType), gethandlesize (h) - sizeof (OSType), bs);
03737                     
03738                     break;
03739                 }
03740             */
03741             
03742             break;
03743             }
03744         
03745         case externalvaluetype:
03746             langexternalgetdisplaystring ((hdlexternalhandle) val.data.externalvalue, bs);
03747             
03748             break;
03749         
03750         #if !flruntime
03751         
03752         case codevaluetype:
03753             parsenumberstring (langmiscstringlist, treesizestring, langcounttreenodes (val.data.codevalue), bs);
03754             
03755             break;
03756         
03757         case tokenvaluetype:
03758             langgetmiscstring (tokennumberstring, bs);
03759             
03760             pushint (val.data.tokenvalue, bs);
03761             
03762             break;
03763         
03764         #endif
03765         
03766         default:
03767             langgetmiscstring (unknownstring, bs);
03768         } /*switch*/
03769     
03770     enablelangerror ();
03771     
03772     return (true);
03773     } /*hashgetvaluestring*/
03774 #endif
03775 
03776 boolean hashgettypestring (tyvaluerecord val, bigstring bstype) {
03777     
03778     switch (val.valuetype) {
03779         
03780         case novaluetype:
03781             langgetmiscstring (nonestring, bstype);
03782             
03783             break;
03784         
03785         case intvaluetype: case longvaluetype:
03786             langgetmiscstring (numberstring, bstype);
03787             
03788             break;
03789         
03790         /*
03791         case tokenvaluetype:
03792             copystring ((ptrstring) "\pverb", bstype);
03793             
03794             break;
03795         
03796         case codevaluetype:
03797             copystring ((ptrstring) "\phandler", bstype);
03798             
03799             break;
03800         */
03801         
03802         case externalvaluetype:
03803             langexternaltypestring ((hdlexternalhandle) val.data.externalvalue, bstype);
03804             
03805             break;
03806         
03807         default:
03808             langgettypestring (val.valuetype, bstype);
03809             
03810             break;
03811         } /*switch*/
03812     
03813     return (true);
03814     } /*hashgettypestring*/
03815 
03816 
03817 boolean hashgetsizestring (const tyvaluerecord *val, bigstring bssize) {
03818     
03819     /*
03820     the size string tells you how much storage is allocated for the value.  if it
03821     returns non-empty, you might want to display it along with the type string.
03822     
03823     we only return non-empty size strings for types where size is interesting.  not
03824     for chars, ints, longs, booleans, dates, etc.
03825     */
03826     
03827     long size;
03828     
03829     switch ((*val).valuetype) {
03830         
03831         case stringvaluetype:
03832         case listvaluetype:
03833         case recordvaluetype:
03834             if (langgetvalsize (*val, &size))
03835                 numbertostring (size, bssize);
03836             
03837             break;
03838         
03839         #ifndef version5orgreater
03840             case addressvaluetype:
03841                 size = stringlength (bsvalue);
03842                 
03843                 if (size > 0) /*non-empty address; don't count the '@' character*/
03844                     --size;
03845                 
03846                 numbertostring (size, bssize);
03847                 
03848                 break;
03849         #endif
03850 
03851         case binaryvaluetype: {
03852             register Handle h = (*val).data.binaryvalue;
03853             OSType typeid;
03854             
03855             typeid = getbinarytypeid (h);
03856             
03857             ostypetostring (typeid, bssize);
03858             
03859             break;
03860             }
03861         
03862         default:
03863             setemptystring (bssize); /*often this string stays empty*/
03864             
03865             break;
03866         } /*switch*/
03867     
03868     return (true);
03869     } /*hashgetsizestring*/
03870 
03871 
03872 boolean hashvaltostrings (tyvaluerecord val, bigstring bstype, bigstring bsvalue, bigstring bssize) {
03873     
03874     /*
03875     give me a value record and I'll return three strings suitable for display.
03876     
03877     the first string indicates the type of the value, and the second is the value.
03878     
03879     the third string tells you how much storage is allocated for the value.  if it
03880     returns non-empty, you might want to display it along with the type string.
03881     
03882     we only return non-empty size strings for types where size is interesting.  not
03883     for chars, ints, longs, booleans, dates, etc.
03884     
03885     10/7/91 dmb: for performance, don't call getvalsize for addresses -- we can 
03886     do a quick calc with the value string, instead of regenerating the full path.
03887     */
03888     
03889     hashgetvaluestring (val, bsvalue);
03890     
03891     hashgettypestring (val, bstype);
03892     
03893     hashgetsizestring (&val, bssize);
03894     
03895     return (true);
03896     } /*hashvaltostrings*/
03897 
03898 
03899 
03900 
03901 

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