Menu
▾
▴
SF.net SVN: frontierkernel: [1625] Frontier/branches/ Frontier_Long_File_Paths/Common
|
From: <cre...@us...> - 2007-02-24 00:04:28
|
Revision: 1625
http://svn.sourceforge.net/frontierkernel/?rev=1625&view=rev
Author: creecode
Date: 2007-02-23 16:04:28 -0800 (Fri, 23 Feb 2007)
Log Message:
-----------
support for long odb item names and file paths
formatting tweaks
Modified Paths:
--------------
Frontier/branches/Frontier_Long_File_Paths/Common/headers/langdll.h
Frontier/branches/Frontier_Long_File_Paths/Common/source/langdll.c
Frontier/branches/Frontier_Long_File_Paths/Common/source/langerror.c
Frontier/branches/Frontier_Long_File_Paths/Common/source/langerrorwindow.c
Frontier/branches/Frontier_Long_File_Paths/Common/source/langevaluate.c
Frontier/branches/Frontier_Long_File_Paths/Common/source/langexternal.c
Modified: Frontier/branches/Frontier_Long_File_Paths/Common/headers/langdll.h
===================================================================
--- Frontier/branches/Frontier_Long_File_Paths/Common/headers/langdll.h 2007-02-23 21:45:04 UTC (rev 1624)
+++ Frontier/branches/Frontier_Long_File_Paths/Common/headers/langdll.h 2007-02-24 00:04:28 UTC (rev 1625)
@@ -77,8 +77,8 @@
odbBool xCALLBACK extInvoke (bigstring bsscriptname, void * pDispParams, odbValueRecord * retval, boolean *flfoundhandler, unsigned int * errarg);
odbBool xCALLBACK extCoerce (odbValueRecord * odbval, odbValueType newtype);
-odbBool xCALLBACK extCallScript (odbString bspath, odbValueRecord *vparams, odbValueRecord *value); /* 2002-10-13 AR */
-odbBool xCALLBACK extCallScriptText (odbString bspath, odbValueRecord *vparams, Handle * text); /* 2002-10-13 AR */
+odbBool xCALLBACK extCallScript ( const Handle, odbValueRecord *, odbValueRecord * ); /* 2002-10-13 AR */
+odbBool xCALLBACK extCallScriptText ( const Handle, odbValueRecord *, Handle * ); /* 2002-10-13 AR */
odbBool xCALLBACK extThreadYield (void); /* 2003-04-22 AR */
odbBool xCALLBACK extThreadSleep (long sleepticks); /* 2003-04-22 AR */
Modified: Frontier/branches/Frontier_Long_File_Paths/Common/source/langdll.c
===================================================================
--- Frontier/branches/Frontier_Long_File_Paths/Common/source/langdll.c 2007-02-23 21:45:04 UTC (rev 1624)
+++ Frontier/branches/Frontier_Long_File_Paths/Common/source/langdll.c 2007-02-24 00:04:28 UTC (rev 1625)
@@ -786,13 +786,16 @@
} /*extInvoke*/
-odbBool xCALLBACK extCallScript (odbString bspath, odbValueRecord *vparams, odbValueRecord *value) {
+odbBool xCALLBACK extCallScript ( const Handle handlePath, odbValueRecord *vparams, odbValueRecord *value) {
+
+ //
+ // 2007-02-23 creedon: support for long odb item names and file paths
+ //
+ // 2002-10-13 AR: Run the script at bspath with the parameters supplied in
+ // vparams. This is an adaption of callscriptverb
+ // (langverbs.c) for the DLL callback interface.
+ //
- /*
- 2002-10-13 AR: Run the script at bspath with the parameters supplied in vparams.
- This is an adaption of callscriptverb (langverbs.c) for the DLL callback interface.
- */
-
odbBool res = false;
tyvaluerecord val;
tyvaluerecord vret;
@@ -803,7 +806,7 @@
convertodbtotyval (vparams, &val);
- if (langrunscript (bspath, &val, nil, &vret)) {
+ if (langrunscript (handlePath, &val, nil, &vret)) {
exemptfromtmpstack (&vret);
@@ -812,21 +815,26 @@
(*value).data.binaryvalue = vret.data.binaryvalue; /*largest field covers everything*/
res = true;
+
}
}
releasethreadglobals ();
return (res);
+
} /* extCallScript */
-odbBool xCALLBACK extCallScriptText (odbString bspath, odbValueRecord *vparams, Handle * text) {
+odbBool xCALLBACK extCallScriptText ( const Handle handlePath, odbValueRecord *vparams, Handle *text ) {
- /*
- 2002-10-13 AR: Like extCallScript, but coerce the result to a string and return it
- */
-
+ //
+ // 2007-02-23 creedon: support for long odb item names and file paths
+ //
+ // 2002-10-13 AR: Like extCallScript, but coerce the result to a string and
+ // return it
+ //
+
odbBool res = false;
tyvaluerecord val;
tyvaluerecord vret;
@@ -837,7 +845,7 @@
convertodbtotyval (vparams, &val);
- if (langrunscript (bspath, &val, nil, &vret)) {
+ if (langrunscript (handlePath, &val, nil, &vret)) {
if (coercetostring (&vret)) {
@@ -846,6 +854,7 @@
*text = vret.data.binaryvalue;
res = true;
+
}
}
}
@@ -853,6 +862,7 @@
releasethreadglobals ();
return (res);
+
} /* extCallScriptText */
@@ -1034,7 +1044,7 @@
getfsfile ( &fs, bs );
- lang2paramerror (cantfindprocinfofunctionerror, bsprocname, bs );
+ lang2ParamErrBs ( cantfindprocinfofunctionerror, bsprocname, bs );
return (false);
} // locateprocinfo
@@ -1257,10 +1267,10 @@
if (bsprocname != nil)
- lang2paramerror (cantfindprocinfoerror, bsprocname, bs);
+ lang2ParamErrBs ( cantfindprocinfoerror, bsprocname, bs);
else
- langparamerror (cantfindprocinfoloaderror, bs );
+ langParamErrBs ( cantfindprocinfoloaderror, bs );
return (false);
@@ -1469,11 +1479,13 @@
//
// Platform-specific code for loading the library code into memory
//
+ // 2007-02-23 creedon: support for long odb item names and file paths
+ //
// 2006-06-25 creedon: for Mac, FSRef-ized
//
-
+
tyfilespec fs = (**hdll).fs;
-
+
#ifdef WIN95VERSION
bigstring fn;
@@ -1488,6 +1500,7 @@
(**hdll).hdllsyshandle = (tydllsyshandle) COMStartup(); /*** FIXME: make sure we deal properly with the COM DLL ***/
return ((**hdll).hdllsyshandle != nil);
+
}
#endif
@@ -1532,13 +1545,20 @@
if ((**hdll).hdllsyshandle == NULL) {
+ Handle h;
bigstring bs;
getfsfile ( &fs, bs );
-
- lang2paramerror (cantconnecttodllerror, bsfunctionname, bs );
+ if ( ! newtexthandle ( bs, &h ) )
+ return ( false );
+
+ lang2paramerror ( cantconnecttodllerror, handleFunctionName, h );
+
+ disposehandle ( h );
+
return (false);
+
}
return (true);
@@ -1778,7 +1798,7 @@
getfsfile ( &fs, bs );
- lang2paramerror (cantfinddllfunctionerror, (**hprocinfo).bsprocname, bs );
+ lang2ParamErrBs ( cantfinddllfunctionerror, (**hprocinfo).bsprocname, bs );
goto exit;
}
@@ -1826,6 +1846,7 @@
#endif
langerrormessage (errmsg);
+
}
exit:
@@ -1871,6 +1892,7 @@
(**hdll).ctreferences--;
return (fl);
+
} /*callproc*/
@@ -1898,6 +1920,7 @@
unloadlibrary (hdll);
return (fl);
+
} /*callstayresident*/
@@ -1944,6 +1967,7 @@
unloadlibrary (hdll);
return (fl);
+
} /*callvolatile*/
@@ -1956,6 +1980,7 @@
*/
return (getlibrary (fs) != nil);
+
} /*islibraryloaded*/
@@ -1986,11 +2011,13 @@
}
addlibrary (hdll);
+
}
*hdllptr = hdll;
return (true);
+
} /*dodllload*/
@@ -2014,6 +2041,7 @@
}
return (true);
+
} /*dodllunload*/
@@ -2034,6 +2062,7 @@
fl = callvolatile (hparam1, fs, bsprocname, vreturned);
return (fl);
+
} /*dodllcall*/
@@ -2099,10 +2128,13 @@
info->resulttype = gettypefromchar (parameterline[0]);
for (i = 0; i < info->ctparams; i++) {
+
info->paramtypes[i] = gettypefromchar (parameterline[i+1]);
+
}
return (true);
+
}
}
@@ -2166,8 +2198,11 @@
info->moduleDesc.routineRecords [0].procDescriptor = (ProcPtr)info->procAddress; // fill in the blank
info->moduleUPP = (UniversalProcPtr) &(info->moduleDesc);
+
}
+
#endif
+
#endif
#ifdef WIN95VERSION
@@ -2176,19 +2211,22 @@
if (info->procAddress == NULL) {
- lang2paramerror (cantfinddllfunctionerror, bsprocname, fsname (fs));
+ lang2ParamErrBs ( cantfinddllfunctionerror, bsprocname, fsname (fs));
return (false);
+
}
if (!parseprocdata (procname, info)) {
- lang2paramerror (cantfindprocinfofunctionerror, bsprocname, fsname (fs));
+ lang2ParamErrBs ( cantfindprocinfofunctionerror, bsprocname, fsname (fs));
return (false);
+
}
return (true);
+
} /*getprocinfo*/
@@ -2229,6 +2267,7 @@
#endif
return (*hModule != NULL);
+
} /*islibraryloaded*/
@@ -2291,7 +2330,7 @@
#endif
if (hModule == NULL)
- lang2paramerror (cantconnecttodllerror, bsfunctionname, fsname (fs));
+ lang2ParamErrBs ( cantconnecttodllerror, handleFunctionName, fsname (fs));
return (hModule);
} /*doloadlibrary*/
@@ -2310,6 +2349,7 @@
#ifdef MACVERSION
return (CloseConnection ((CFragConnectionID *) &hModule) == noErr);
#endif
+
} /*dofreelibrary*/
@@ -2329,7 +2369,7 @@
load the dll, find the module, and map its parameter info to our types.
*/
- copystring (bsprocname, bsfunctionname); // for error reporting
+ copystring (bsprocname, handleFunctionName); // for error reporting
info->moduleHandle = doloadlibrary (fs, false);
@@ -2364,19 +2404,22 @@
HLock (hRes);
info->pdata = *hRes;
+
}
CloseResFile (resfile);
+
}
#endif
if (info->pdata == NULL) {
- lang2paramerror (cantfindprocinfoerror, bsprocname, fsname (fs));
+ lang2ParamErrBs ( cantfindprocinfoerror, bsprocname, fsname (fs));
dofreelibrary (info->moduleHandle, false);
goto exit;
+
}
if (getprocinfo (fs, bsprocname, info))
@@ -2391,6 +2434,7 @@
#endif
return (fl);
+
} /*loaddllmodule*/
@@ -2399,6 +2443,7 @@
/*
call the dll.
*/
+
boolean fl = false;
releasethreadglobals ();
@@ -2427,6 +2472,7 @@
grabthreadglobals ();
return fl;
+
} /*langcalldll*/
#endif /* NEW_DLL_INTERFACE */
@@ -2725,13 +2771,13 @@
tyfilespec fsdll;
bigstring bsprocname;
-
+
if (!getfilespecvalue (hparam1, 1, &fsdll))
return (false);
-
+
if (!getstringvalue (hparam1, 2, bsprocname))
return (false);
-
+
return (dodllcall (hparam1, &fsdll, bsprocname, vreturned));
#else
@@ -2817,11 +2863,12 @@
(*vreturned).data.longvalue = dllcall.resultdata;
- pushvalueontmpstack (vreturned);
+ pushvalueontmpstack (vreturned);
+
}
}
- else
- {
+ else {
+
bigstring errmsg;
#ifdef MACVERSION
@@ -2831,6 +2878,7 @@
#endif
langerrormessage (errmsg);
+
}
return (fl);
@@ -2849,5 +2897,6 @@
if (dllcallbacks != nil)
fillcalltable (dllcallbacks);
}
+
} /*initdllverbs*/
Modified: Frontier/branches/Frontier_Long_File_Paths/Common/source/langerror.c
===================================================================
--- Frontier/branches/Frontier_Long_File_Paths/Common/source/langerror.c 2007-02-23 21:45:04 UTC (rev 1624)
+++ Frontier/branches/Frontier_Long_File_Paths/Common/source/langerror.c 2007-02-24 00:04:28 UTC (rev 1625)
@@ -34,29 +34,29 @@
#include "langinternal.h"
-
boolean fllangerror = false; /*if true, the langerror dialog has already appeared*/
unsigned short langerrordisable = 0; /*it's possible to temporarily disable lang errors*/
-
-
void disablelangerror (void) {
++langerrordisable;
+
} /*disablelangerror*/
void enablelangerror (void) {
--langerrordisable;
+
} /*enablelangerror*/
boolean langerrorenabled (void) {
return (langerrordisable == 0);
+
} /*langerrorenabled*/
@@ -87,40 +87,83 @@
getstringlist (langerrorlist, stringnum, bs);
langerrormessage (bs);
+
} /*langerror*/
-void lang3paramerror (short stringnum, const bigstring bs1, const bigstring bs2, const bigstring bs3) {
+void lang3paramerror ( short stringnum, const Handle h1, const Handle h2, const Handle h3 ) {
+
+ //
+ // 2007-02-23 creedon: support for long odb item names and file paths
+ //
+ Handle h;
bigstring bs;
getstringlist (langerrorlist, stringnum, bs);
- parsedialogstring (bs, (ptrstring) bs1, (ptrstring) bs2, (ptrstring) bs3, nil, bs);
+ newtexthandle ( bs, &h );
+ parsedialoghandle ( h, h1, h2, h3, nil );
+
+ texthandletostring ( h, bs );
+
+ disposehandle ( h );
+
langerrormessage (bs);
- } /*lang3paramerror*/
+
+ } // lang3paramerror
-void langparamerror (short stringnum, const bigstring bsparam) {
+void lang3ParamErrBs ( short stringnum, const bigstring bs1, const bigstring bs2, const bigstring bs3 ) {
- lang3paramerror (stringnum, bsparam, nil, nil);
- } /*langparamerror*/
+ bigstring bs;
+
+ getstringlist ( langerrorlist, stringnum, bs );
+
+ parsedialogstring ( bs, ( ptrstring ) bs1, ( ptrstring ) bs2, ( ptrstring ) bs3, NULL, bs );
+
+ langerrormessage ( bs );
+
+ } // lang3ParamErrBs
-void lang2paramerror (short stringnum, const bigstring bs1, const bigstring bs2) {
+void langparamerror ( short stringnum, const Handle h ) {
- lang3paramerror (stringnum, bs1, bs2, nil);
- } /*lang2paramerror*/
+ lang3paramerror ( stringnum, h, NULL, NULL );
+
+ } // langparamerror
+void langParamErrBs ( short stringnum, const bigstring bs ) {
+
+ lang3ParamErrBs ( stringnum, bs, NULL, NULL );
+
+ } // langParamErrBs
+
+
+void lang2paramerror ( short stringnum, const Handle h1, const Handle h2 ) {
+
+ lang3paramerror ( stringnum, h1, h2, NULL );
+
+ } // lang2paramerror
+
+
+void lang2ParamErrBs ( short stringnum, const bigstring bs1, const bigstring bs2 ) {
+
+ lang3ParamErrBs ( stringnum, bs1, bs2, NULL );
+
+ } // lang2ParamErrBs
+
+
void langlongparamerror (short stringnum, long x) {
byte bslong [64];
numbertostring (x, bslong);
- lang3paramerror (stringnum, bslong, nil, nil);
+ lang3ParamErrBs ( stringnum, bslong, nil, nil);
+
} /*langlongparamerror*/
@@ -130,7 +173,8 @@
ostypetostring (x, bsid);
- lang3paramerror (stringnum, bsid, nil, nil);
+ lang3ParamErrBs ( stringnum, bsid, nil, nil);
+
} /*langostypeparamerror*/
@@ -142,8 +186,7 @@
convertcstring (bscopy); /*convert a c string to pascal format*/
- langparamerror (parsererror, bscopy);
+ langParamErrBs ( parsererror, bscopy);
+
} /*parseerror*/
-
-
Modified: Frontier/branches/Frontier_Long_File_Paths/Common/source/langerrorwindow.c
===================================================================
--- Frontier/branches/Frontier_Long_File_Paths/Common/source/langerrorwindow.c 2007-02-23 21:45:04 UTC (rev 1624)
+++ Frontier/branches/Frontier_Long_File_Paths/Common/source/langerrorwindow.c 2007-02-24 00:04:28 UTC (rev 1625)
@@ -514,17 +514,23 @@
pe = &(**hs).stack [ix];
return ((*(*pe).errorcallback) ((*pe).errorrefcon, (*pe).errorline, (*pe).errorchar, nil, nil));
+
} /*langerrorpopupselect*/
static boolean langerrorfillerrorpopup (hdlmenu hmenu, short *checkeditem) {
+
+ //
+ // 2007-02-23 creedon: support for long odb item names and file paths
+ //
register hdlerrorstack hs = (**langerrordata).herrorstack;
- register short ix;
- register short ixtop;
- hdlhashtable htable;
+ register short ix, ixtop;
+
+ Handle handleName;
bigstring bsname;
boolean flenabled;
+ hdlhashtable htable;
if (hs == nil)
return (false);
@@ -535,17 +541,20 @@
tyerrorrecord *pe = &(**hs).stack [ix];
- if ((*pe).errorcallback == nil ||
- !(*(*pe).errorcallback) ((*pe).errorrefcon, 0, 0, &htable, bsname)) {
+ if ( ( *pe ).errorcallback == nil || ! ( *( *pe ).errorcallback ) ( ( *pe ).errorrefcon, 0, 0, &htable, &handleName ) ) {
- langgetstringlist (anomynousthreadstring, bsname);
+ langgetstringlist ( anomynousthreadstring, bsname );
flenabled = false;
+
}
- else {
+ else
flenabled = true;
- }
+ texthandletostring ( handleName, bsname );
+
+ disposehandle ( handleName );
+
if (!pushpopupitem (hmenu, bsname, flenabled, 0)) /*terminate visit on error*/
return (false);
}
@@ -553,8 +562,10 @@
*checkeditem = -1;
return (true);
+
} /*langerrorfillerrorpopup*/
+
static boolean langerrorpopupmenu (void) {
/*
@@ -682,9 +693,10 @@
} /*langerrorkeystroke*/
-boolean langerrordialog (bigstring bsmsg, ptrvoid refcon) {
-#pragma unused (refcon)
+boolean langerrordialog ( bigstring bsmsg, ptrvoid refcon ) {
+ #pragma unused (refcon)
+
unsigned short savedlines, savedchars;
if (isemptystring (bsmsg)) /*don't post empty messages -- scipterrror ("") relies on this*/
@@ -697,6 +709,7 @@
ctscanlines = savedlines; ctscanchars = savedchars; /*restore*/
return (true);
+
} /*langerrordialog*/
Modified: Frontier/branches/Frontier_Long_File_Paths/Common/source/langevaluate.c
===================================================================
--- Frontier/branches/Frontier_Long_File_Paths/Common/source/langevaluate.c 2007-02-23 21:45:04 UTC (rev 1624)
+++ Frontier/branches/Frontier_Long_File_Paths/Common/source/langevaluate.c 2007-02-24 00:04:28 UTC (rev 1625)
@@ -55,25 +55,31 @@
#ifdef PASCALSTRINGVERSION
-byte bscontainername [] = "\x0a" "_container\0";
-static byte nametryerrorval [] = "\x08" "tryerror\0";
-
-#if fltryerrorstackcode
- static byte nametryerrorstackval [] = "\x0d" "tryerrorstack\0";
-#endif
-
+ byte bscontainername [ ] = "\x0a" "_container\0";
+
+ static byte nametryerrorval [ ] = "\x08" "tryerror\0";
+
+ #if fltryerrorstackcode
+
+ static byte nametryerrorstackval [ ] = "\x0d" "tryerrorstack\0";
+
+ #endif
+
#else
-byte bscontainername [] = "_container";
-
-static byte nametryerrorval [] = "tryerror";
-
-#if fltryerrorstackcode
- static byte nametryerrorstackval [] = "tryerrorstack";
+ byte bscontainername [ ] = "_container";
+
+ static byte nametryerrorval [ ] = "tryerror";
+
+ #if fltryerrorstackcode
+
+ static byte nametryerrorstackval [ ] = "tryerrorstack";
+
+ #endif
+
#endif
-#endif
void langseterrorline (hdltreenode hnode) {
@@ -92,7 +98,9 @@
ctscanchars = (**hnode).charnum;
herrornode = hnode;
+
}
+
} /*langseterrorline*/
@@ -101,18 +109,19 @@
#if fldebug > 0
static boolean validvalue (tyvaluerecord *val) {
-
+
Handle h;
if (!langheapallocated (val, &h))
return (true);
+
+ return (validhandle (h));
- return (validhandle (h));
} /*validvalue*/
static boolean leakingmemory (tyvaluerecord *val) {
-
+
/*
1/14/91 dmb: verify that val is in the temp stack if it's heap-allocated
*/
@@ -120,22 +129,23 @@
register Handle h;
register short ctloops;
register tyvaluerecord *p;
+
Handle hcheck;
if (!langheapallocated (val, &hcheck))
return (false);
-
+
if ((*val).fltmpdata) /*data has never been copied from original*/
return (false);
-
+
if ((*val).valuetype == externalvaluetype)
return (false);
-
+
h = hcheck; /*move into register*/
if (currenthashtable == nil)
return (true);
-
+
p = (**currenthashtable).tmpstack;
for (ctloops = (**currenthashtable).cttmpstack; ctloops--; ++p) { /*step through tmpstack*/
@@ -145,17 +155,20 @@
assert (validvalue (val)); /*make sure it's not already disposed*/
return (false);
+
}
+
} /*while*/
return (true); /*didn't find it -- it's a leak!*/
+
} /*leakingmemory*/
#else
#define validvalue(v) (true)
#define leakingmemory(v) (false)
-
+
#endif
#endif
@@ -293,108 +306,131 @@
flbreak = false; /*only good for one level*/
return (true);
+
}
if (!langdebuggercall (h)) /*user killed the script*/
return (false);
+
} /*for*/
return (true);
+
} /*evaluateforloop*/
static boolean evaluateforinloop (hdltreenode hloop, tyvaluerecord vlist, tyvaluerecord *valtree) {
+
+ //
+ // 2007-02-23 creedon: support for long odb item names and file paths
+ //
+ // 6.1b12 AR: Fixed crashes when trying to loop over root table.
+ //
+ // 6.1d19 AR: Make work for tables too. (Again?)
+ //
+ // 4.28.97 dmb: put list "counter" value in valtree, so it's the statement
+ // value if nothing is return-d.
+ //
+ // 4.1b8 dmb: fixed bug when evaluatetree within the loop returns false.
+ //
+ // 1993-04-14 dmb: don't try to coerce records to lists; leave them as is.
+ //
+ // 1993-03-19 dmb: make work for tables too.
+ //
+ // 1993-03-17 dmb: a new loop for list processing:
+ //
+ // for counter in x
+ // <body>
+ //
- /*
- 3/17/93 dmb: a new loop for list processing:
-
- for counter in x
- <body>
-
- 3/19/93 dmb: make work for tables too.
-
- 4/14/93 dmb: don't try to coerce records to lists; leave them as is.
-
- 4.1b8 dmb: fixed bug when evaluatetree within the loop returns false.
-
- 4.28.97 dmb: put list "counter" value in valtree, so it's the statement value
- if nothing is return-d.
+ register hdltreenode htn = hloop;
- 6.1d19 AR: Make work for tables too. (Again?)
-
- 6.1b12 AR: Fixed crashes when trying to loop over root table.
- */
+ register hdltreenode hcounter = (**htn).param2;
+ register long ixlist = 0;
+ Handle handleName;
+ boolean fl = false, fltable = false;
+ hdlhashnode hnode;
hdlhashtable htable;
- register hdltreenode h = hloop;
- register long ixlist = 0;
long ctitems;
- register hdltreenode hcounter = (**h).param2;
- boolean fltable = false;
- boolean fl = false;
- bigstring bsname;
- hdlhashnode hnode;
if (vlist.valuetype == addressvaluetype) {
+ Handle h;
hdlhashtable ht;
- bigstring bs;
tyvaluerecord val;
- if (!getaddressvalue (vlist, &ht, bs))
+ if (!getaddressvalue (vlist, &ht, &h))
return (false);
- if (ht == nil && langgetspecialtable (bs, &htable))
+ if (ht == nil && langgetspecialtable (h, &htable))
fltable = true;
if (!fltable) {
- if (ht == nil && !langsearchpathlookup (bs, &ht)) {
- langparamerror (unknownidentifiererror, bs);
- return (false);
+ if (ht == nil && !langsearchpathlookup (h, &ht)) {
+
+ langparamerror ( unknownidentifiererror, h );
+
+ disposehandle ( h );
+
+ return ( false );
+
}
-
- if (!langhashtablelookup (ht, bs, &val, &hnode))
- return (false);
-
+
+ if (!langhashtablelookup (ht, h, &val, &hnode)) {
+
+ disposehandle ( h );
+
+ return ( false );
+
+ }
+
if (langexternalvaltotable (val, &htable, hnode))
fltable = true;
}
+
+ disposehandle ( h );
+
}
-
+
if (!fltable) {
if (vlist.valuetype != recordvaluetype)
if (!coercetolist (&vlist, listvaluetype))
return (false);
-
+
if (!langgetlistsize (&vlist, &ctitems))
return (false);
+
+ exemptfromtmpstack (&vlist); /*protect our list*/
- exemptfromtmpstack (&vlist); /*protect our list*/
}
+
+ while (true) {
- while (true) {
+ if (fltable) {
- if (fltable) {
-
- if (!hashgetiteminfo (htable, ixlist++, bsname, nil)) { /* 0-based */
-
+ if (!hashgetiteminfo (htable, ixlist++, &handleName, nil)) { /* 0-based */
+
fl = true;
-
+
break;
+
}
-
- setaddressvalue (htable, bsname, valtree);
+
+ setaddressvalue (htable, handleName, valtree);
+
+ disposehandle ( handleName );
+
}
-
else {
-
if (++ixlist > ctitems) { /* 1-based */
fl = true;
break;
+
}
if (!langgetlistitem (&vlist, ixlist, nil, valtree)) // 4.28.97 dmb: use valtree, not local val
@@ -412,7 +448,7 @@
flcontinue = false;
- fl = evaluatelist ((**h).param4, valtree);
+ fl = evaluatelist ((**htn).param4, valtree);
if (!fl)
break;
@@ -428,107 +464,24 @@
fl = true;
break;
+
}
+
+ if (!langdebuggercall (htn)) /*user killed the script*/
+ break;
+
+ } // while
-
- if (!langdebuggercall (h)) /*user killed the script*/
- break;
- } /*for*/
-
if (!fltable)
disposetmpvalue (&vlist);
+
+ return ( fl );
- return (fl);
} /*evaluateforinloop*/
-#if 0 /*support for fileloop file filtering*/
-#include "strings.h"
-#include "tableverbs.h"
+static boolean fileloopguts (hdltreenode htree, ptrfilespec fsfolder, const Handle handleIdentifier, long ctlevels, tyvaluerecord *valtree) {
-
-static hdlhashtable hfiletable = nil;
-
-static hdltreenode hpathtree = nil;
-
-/*
-static hdltreenode hfilecalltree = nil;
-*/
-
-static boolean fileidvaluecallback (hdltreenode htree, tyvaluerecord *val) {
-
- register hdltreenode h = htree;
- bigstring bsverb;
-
- if ((**h).nodetype != identifierop)
- return (false);
-
- langgetidentifier (h, bsverb);
-
- if (!hashtablesymbolexists (hfiletable, bsverb))
- return (false);
-
- return (kernelfunctionvalue (hfiletable, bsverb, hpathtree, val));
- } /*fileidvaluecallback*/
-
-
-static hdltreenode hfiltertree;
-
-
-static boolean fileloopfilter (bigstring bsfolder, bigstring bsfile) {
-
- /*
- 6.2b15 AR: Call coercetoboolean directly instead of the now defunct truevalue
- */
-
- tyvaluerecord val;
- boolean fl;
- bigstring bspath;
- Handle hpath;
-
- if (hfiletable == nil) { /****need to do 1-time initialization*/
-
- initvalue (&val, stringvaluetype);
-
- if (!newconstnode (val, &hpathtree))
- return (false);
-
- findnamedtable (efptable, "\pfile", &hfiletable);
- }
-
- if (isfolderpath (bsfile))
- return (true);
-
- addstrings (bsfolder, bsfile, bspath);
-
- if (!newtexthandle (bspath, &hpath))
- return (false);
-
- (**hpathtree).nodeval.data.stringvalue = hpath;
-
- langcallbacks.idvaluecallback = &fileidvaluecallback;
-
- fl = evaluatetree (hfiltertree, &val);
-
- cleartmpstack ();
-
- langcallbacks.idvaluecallback = nil;
-
- disposehandle (hpath);
-
- if (!fl)
- return (false);
-
- if (!coercetoboolean (&val))
- return (false);
-
- return (val.data.flvalue);
- } /*fileloopfilter*/
-
-#endif
-
-static boolean fileloopguts (hdltreenode htree, ptrfilespec fsfolder, bigstring bsidentifier, long ctlevels, tyvaluerecord *valtree) {
-
//
// the core of fileloop evaluation, now recursive.
//
@@ -536,6 +489,8 @@
//
// if ctlevels is not -1, only process files, and recurse for folders to the specified depth
//
+ // 2007-02-23 creedon: support for long odb item names and file paths
+ //
// 2006-10-26 creedon: on Mac, fix a problem with CFRelease releasing data that needed to hang around
//
// 2006-10-03 creedon: for Mac, minimally FSRef-ized
@@ -543,12 +498,13 @@
// 1992-10-08 dmb: break & return must kick out of all levels of recursion (whew!)
//
+ register boolean fl;
register hdltreenode h = htree;
- register boolean fl;
+
+ Handle hfileloop;
+ boolean flfolder;
+ tyfilespec fs;
tyvaluerecord val;
- tyfilespec fs;
- boolean flfolder;
- Handle hfileloop;
clearbytes ( &fs, sizeof ( fs ) );
@@ -580,7 +536,7 @@
if (ctlevels > 0) {
- fl = fileloopguts (h, &fs, bsidentifier, ctlevels - 1, valtree);
+ fl = fileloopguts (h, &fs, handleIdentifier, ctlevels - 1, valtree);
if (!fl)
break;
@@ -619,7 +575,7 @@
if (!fl)
break;
- fl = langsetsymbolval (bsidentifier, val); // user program gets the name
+ fl = langsetsymbolval (handleIdentifier, val); // user program gets the name
if (!fl)
break;
@@ -659,65 +615,75 @@
static boolean evaluatefileloop (hdltreenode hloop, tyvaluerecord *valtree) {
+
+ //
+ // 2007-02-23 creedon: support for long odb item names and file paths
+ //
+ // 1992-10-08 dmb: must clear flbreak here so that fileloopguts can leave
+ // it set while unwinding recursion
+ //
+ // 1992-04-24 dmb: removed misplaced & redundant leakingmemory check
+ //
+ // 1990-07-09 DW: bug -- fileloops leak memory.
+ //
- /*
- 7/9/90 DW: bug -- fileloops leak memory.
+ register hdltreenode h = hloop;
+ register hdltreenode hp = (**h).param2;
- 4/24/92 dmb: removed misplaced & redundant leakingmemory check
-
- 10/8/92 dmb: must clear flbreak here so that fileloopguts can leave it set
- while unwinding recursion
- */
-
- register hdltreenode h = hloop;
+ Handle handleIdentifier = NULL;
+ boolean fl = false;
+ long ctlevels;
tyfilespec fsfolder;
- bigstring bsidentifier;
tyvaluerecord val;
- register hdltreenode hp = (**h).param2;
- long ctlevels;
if (!evaluatetree (hp, &val)) /*the path is the second parameter*/
return (false);
-
+
if (!coercetofilespec (&val))
return (false);
-
+
assert (!leakingmemory (&val));
- fsfolder = **val.data.filespecvalue;
+ fsfolder = **val.data.filespecvalue;
- if (!langgetidentifier ((**h).param1, bsidentifier))
+ if ( ! langgetidentifier ( ( **h ).param1, &handleIdentifier ) )
return (false);
-
+
hp = (**h).param4; /*copy into register*/
if (hp == nil) /*no depth clause*/
ctlevels = -1;
+ else {
- else {
-
if (!evaluatetree (hp, &val))
return (false);
-
+
if (!coercetolong (&val))
return (false);
-
+
ctlevels = val.data.longvalue;
if (ctlevels <= 0)
return (true);
+
+ --ctlevels;
- --ctlevels;
}
-
+
langseterrorline (h); /*reset error reporting after evaulatetree calls*/
- if (!fileloopguts (h, &fsfolder, bsidentifier, ctlevels, valtree))
- return (false);
-
+ if (!fileloopguts (h, &fsfolder, handleIdentifier, ctlevels, valtree))
+ goto exit;
+
flbreak = false; /*good for all levels of single fileloop*/
- return (true);
+ fl = true;
+
+ exit:
+ disposehandle ( handleIdentifier );
+
+ return ( fl );
+
} /*evaluatefileloop*/
@@ -877,10 +843,10 @@
#endif
- if ((hs == nil) || ((**hs).toperror == 0)) {
-
+ if ((hs == nil) || ((**hs).toperror == 0))
+
return (-1);
- }
+
else {
#if TARGET_API_MAC_CARBON == 1
@@ -896,37 +862,40 @@
#endif
return ((**hs).stack [(**hs).toperror - 1].errorrefcon);
+
}
+
} /*langgetlexicalrefcon*/
static boolean evaluatewith (hdltreenode hwith, tyvaluerecord *valtree) {
+
+ //
+ // evaluate a with block. hparam1 should be a list of terminals that
+ // specify tables to add to the search path for the with block.
+ //
+ // 2007-02-23 creedon: support for long odb item names and file paths
+ //
+ // 1992-08-31 dmb: added supports for multiple with items, object
+ // specifiers
+ //
- /*
- evaluate a with block. hparam1 should be a list of terminals that
- specify tables to add to the search path for the with block.
+ register hdlhashtable ht;
+ register hdltreenode h = hwith, hterm;
- 8/31/92 dmb: added supports for multiple with items, object specifiers
- */
-
- register hdltreenode h = hwith;
- register hdltreenode hterm;
- hdlhashtable htable;
- bigstring bs;
- hdlhashtable hlocaltable;
- register hdlhashtable ht;
- tyvaluerecord valtable;
- tyvaluerecord valwith;
+ Handle h2 = NULL;
+ hdlhashnode hnode;
+ hdlhashtable hlocaltable, htable;
short n = 0;
- hdlhashnode hnode;
+ tyvaluerecord valtable, valwith;
if (!newhashtable (&hlocaltable)) /*new table for the function when it runs*/
return (false);
-
+
ht = hlocaltable; /*copy into register*/
(**ht).fllocaltable = true; // 5.1.4 dmb: set now so pre-assignments will know locality of table
-
+
(**ht).lexicalrefcon = langgetlexicalrefcon (); /*'with' expressions use local scope*/
chainhashtable (ht); /*need it in scope to handle multiple items in list*/
@@ -934,84 +903,77 @@
/*populate the local table with path values*/
for (hterm = (**h).param1; hterm != nil; hterm = (**hterm).link) {
+
+ if (isobjspectree (hterm)) {
- if (isobjspectree (hterm)) {
-
if (!evaluateobjspec (hterm, &valwith))
goto error;
-
- copystring (bscontainername, bs);
+
+ if ( ! newtexthandle ( bscontainername, &h2 ) )
+ goto error;
}
else {
-
- if (!langgetdottedsymbolval (hterm, &htable, bs, &valtable, &hnode))
+
+ if (!langgetdottedsymbolval (hterm, &htable, &h2, &valtable, &hnode))
goto error;
+
+ if (!langexternalvaltotable (valtable, &htable, hnode)) {
- /*
- if (langexternalvaltocode (valtable, &hcode)) { /%5/14/93 dmb%/
+ langparamerror ( badwithstatementerror, h2 );
- if (!hashtablelookupnode (htable, bs, &hnode))
- goto error;
+ goto error;
- if (hcode == nil) {
-
- if (!langcompilescript (hnode, &hcode))
- goto error;
- }
-
- if (!addmodulecontext (htable, hnode, bs, hcode))
- goto error;
-
- continue;
}
- */
-
- if (!langexternalvaltotable (valtable, &htable, hnode)) {
- langparamerror (badwithstatementerror, bs);
-
- goto error;
- }
+ disposehandle ( h2 );
- if (!setaddressvalue (htable, zerostring, &valwith))
+ if ( ! setaddressvalue ( htable, NULL, &valwith ) )
goto error;
+
+ if (n == 7) { /*maximum value of ctwithvalues*/
- if (n == 7) { /*maximum value of ctwithvalues*/
-
langlongparamerror (toomanywithtableserror, n);
goto error;
+
}
+
+ langgetwithvaluename ( ++n, &h2 );
- langgetwithvaluename (++n, bs);
+ (**ht).ctwithvalues = n; /*optimization for langfindsymbol*/
- (**ht).ctwithvalues = n; /*optimization for langfindsymbol*/
}
-
- if (!hashtableassign (ht, bs, valwith)) {
+ if ( ! hashtableassign ( ht, h2, valwith ) ) {
+
disposevaluerecord (valwith, false);
goto error;
+
}
+
+ disposehandle ( h2 );
exemptfromtmpstack (&valwith); /*its in the local table now*/
- }
-
+
+ } // for
+
unchainhashtable ();
hmagictable = ht; /*evaluatelist uses this as its local symbol table*/
return (evaluatelist ((**h).param2, valtree));
- error: {
+ error:
+
+ disposehandle ( h2 );
unchainhashtable ();
disposehashtable (ht, false);
return (false);
- }
+
} /*evaluatewith*/
@@ -1161,8 +1123,9 @@
#endif
static boolean langtryerror (bigstring bsmsg, ptrvoid refcon) {
-#pragma unused (refcon)
+ #pragma unused (refcon)
+
/*
6/25/92 dmb: when an error occurs during a try block, we stash it in
the tryerror handle. it is later placed in the stack frame of the
@@ -1174,25 +1137,31 @@
newtexthandle (bsmsg, &tryerror); /*if out of mem, script won't be able to get error*/
#if fltryerrorstackcode
+
assert (tryerrorstack == nil);
langsettryerrorstack();
+
#endif
return (true);
+
} /*langtryerror*/
static boolean evaluatetry (hdltreenode htry, tyvaluerecord *valtree) {
register hdltreenode h = htry;
+
boolean fl;
langerrormessagecallback savecallback;
assert (tryerror == nil);
#if fltryerrorstackcode
+
assert (tryerrorstack == nil);
+
#endif
savecallback = langcallbacks.errormessagecallback;
@@ -1208,10 +1177,13 @@
assert (tryerror == nil);
#if fltryerrorstackcode
+
assert (tryerrorstack == nil);
+
#endif
return (fl); /*might be false if script has been killed*/
+
}
fllangerror = false; /*recover*/
@@ -1225,140 +1197,171 @@
tryerror = nil;
#if fltryerrorstackcode
+
opdisposelist ((hdllistrecord) tryerrorstack);
// disposehandle (tryerrorstack);
tryerrorstack = nil;
+
#endif
return (true);
+
}
//assert (tryerror != nil); //6.1b8 AR: attempt to catch "tryerror not defined" situations
return (evaluatelist (h, valtree)); /*will take care of tryerror automatically*/
+
} /*evaluatetry*/
static boolean langaddlocals (hdltreenode hnode) {
+
+ //
+ // add the names in hnamelist to the most-local symbol table.
+ //
+ // return false if the symbol is already declared in the local table, or
+ // if there was a memory allocation error.
+ //
+ // 2007-02-23 creedon: support for long odb item names and file paths
+ //
+ // 4.28.97 dmb: make sure assignments copy tmpdata
+ //
+ // 4.1b4 dmb: added fllangexternalvalueprotect flag to disable protection
+ //
+ // 2.1b2 dmb: added debugger call for local initial assignments
+ //
+ // 1992-12-11 dmb: set unassigned locals to novaluetype, not zero (long).
+ // this allows them to more easily be used in expressions
+ // and yield expected results.
+ //
+ // 1991-01-17 dmb: simplified code and moved tmpstack logic from
+ // assignlocalop clause to bottom of loop, so on error val
+ // is still in tmpstack and will be disposed later
+ //
- /*
- add the names in hnamelist to the most-local symbol table.
-
- return false if the symbol is already declared in the local table, or
- if there was a memory allocation error.
-
- 1/17/91 dmb: simplified code and moved tmpstack logic from assignlocalop
- clause to bottom of loop, so on error val is still in tmpstack and will
- be disposed later
-
- xxx 12/11/92 dmb: set unassigned locals to novaluetype, not zero (long). this
- xxx allows them to more easily be used in expressions and yield expected results.
-
- 2.1b2 dmb: added debugger call for local initial assignments
-
- 4.1b4 dmb: added fllangexternalvalueprotect flag to disable protection
-
- 4.28.97 dmb: make sure assignments copy tmpdata
- */
-
register hdltreenode nomad = (**hnode).param1;
while (true) { /*step through name list, inserting each into symbol table*/
+ Handle h = NULL;
tyvaluerecord val;
- bigstring bs;
if (nomad == nil) /*reached the end of the names list*/
return (true);
+
+ if ((**nomad).nodetype == assignlocalop) {
- if ((**nomad).nodetype == assignlocalop) {
-
if (!langdebuggercall (nomad)) /*2.1b2*/
return (false);
-
+
if (!evaluatetree ((**nomad).param2, &val))
return (false);
-
+
if (fllangexternalvalueprotect && val.valuetype == externalvaluetype) { /*4.1b4 dmb*/
langbadexternaloperror (externalassignerror, val);
return (false);
+
}
-
- if (!langgetidentifier ((**nomad).param1, bs))
+
+ if ( ! langgetidentifier ( ( **nomad ).param1, &h ) )
return (false);
}
else {
-
initvalue (&val, novaluetype);
- if (!langgetidentifier (nomad, bs))
+ if (!langgetidentifier (nomad, &h))
return (false);
}
- if (hashsymbolexists (bs)) { /*multiply-defined symbol*/
+ if (hashsymbolexists (h)) { /*multiply-defined symbol*/
langseterrorline (nomad); /*point right at the offending name*/
- langparamerror (multiplesymbolerror, bs);
+ langparamerror ( multiplesymbolerror, h );
+ disposehandle ( h );
+
return (false);
+
}
// 4.28.97 dmb: do what hashassign does with tmpdata. shouls hashinsert do this?
if (val.fltmpdata) { /*val doesn't own it's data*/
- if (!copyvaluedata (&val))
+ if ( ! copyvaluedata ( &val ) ) {
+
+ disposehandle ( h );
+
return (false);
+
+ }
+
+ exemptfromtmpstack (&val); /***should wait until success*/
- exemptfromtmpstack (&val); /***should wait until success*/
}
hashsetlocality (&val, true); /*6.2b16 AR*/
- if (!hashinsert (bs, val)) /*error creating new symbol*/
+ if ( ! hashinsert ( h, val ) ) { // error creating new symbol
+
+ disposehandle ( h );
+
return (false);
+
+ }
+ disposehandle ( h );
+
exemptfromtmpstack (&val); /*it's been successfully added to local table*/
cleartmpstack (); /*dealloc all outstanding temporary values*/
nomad = (**nomad).link; /*advance to next name in list*/
+
} /*while*/
+
} /*langaddlocals*/
static boolean langaddhandler (hdltreenode hnode) {
+
+ //
+ // add a handler node to the current hashtable. the structure below hnode
+ // must conform to the structure documented in the comment at the head of
+ // langfunccall.
+ //
+ // 2007-02-23 creedon: support for long odb item names and file paths
+ //
+ // 1991-02-05 dmb: stuff the current scripterrorrefcon into the (otherwise
+ // unused) nodeval so that the script debugger and error
+ // dialog can trace handler calls back to their source.
+ // this would otherwise be quite difficult to do, since the
+ // address of a local handler can be passed around between
+ // scripts and called from anywhere. see
+ // scriptpushsourcecode in scripts.c.
+ //
- /*
- add a handler node to the current hashtable. the structure below hnode
- must conform to the structure documented in the comment at the head of
- langfunccall.
+ register hdltreenode h = hnode;
- 2/5/91 dmb: stuff the current scripterrorrefcon into the (otherwise unused)
- nodeval so that the script debugger and error dialog can trace handler
- calls back to their source. this would otherwise be quite difficult to
- do, since the address of a local handler can be passed around between
- scripts and called from anywhere. see scriptpushsourcecode in scripts.c.
- */
-
- register hdltreenode h = hnode;
- bigstring bs;
+ Handle handleIdentifier = NULL;
tyvaluerecord val;
- if (!langgetidentifier ((**(**h).param2).param1, bs))
- return (false);
+ if ( ! langgetidentifier ( ( **( **h ).param2 ).param1, &handleIdentifier ) )
+ return ( false );
- if (hashsymbolexists (bs)) { /*name already defined in most-local table*/
+ if (hashsymbolexists (handleIdentifier)) { /*name already defined in most-local table*/
- langseterrorline (h); /*point right at the offending name*/
+ langseterrorline ( h ); /*point right at the offending name*/
- langparamerror (multiplesymbolerror, bs);
+ langparamerror ( multiplesymbolerror, handleIdentifier );
return (false);
+
}
initvalue (&val, codevaluetype);
@@ -1367,8 +1370,8 @@
val.fltmpdata = true; /*data belong to code tree*/
- if (!hashinsert (bs, val))
- return (false);
+ if ( ! hashinsert ( handleIdentifier, val ) )
+ return ( false );
bundle { /*link this code value to the source from whence it came*/
@@ -1377,9 +1380,11 @@
val.data.longvalue = langgetlexicalrefcon ();
(**h).nodeval = val;
+
}
return (true);
+
} /*langaddhandler*/
@@ -1413,6 +1418,7 @@
byte evalparam1;
byte evalparam2;
+
} typaraminfo;
#define nope ((byte) -1)
@@ -1542,6 +1548,7 @@
{false, true}, /*multiplyvalueop*/
{false, true} /*dividevalueop*/
+
};
@@ -1591,15 +1598,15 @@
register hdltreenode h = htree;
register tytreetype op;
register short ctparams;
+
tyvaluerecord val1, val2;
setbooleanvalue (true, valtree); /*default returned value*/
- if (fllangerror) { /*a language error dialog has appeared, unwind*/
+ if (fllangerror) /*a language error dialog has appeared, unwind*/
return (false); /*return false, aid in the unwinding process*/
- }
-
+
if (h == nil)
return (true);
@@ -1619,12 +1626,12 @@
#ifdef newparams
- if (info.evalparam1)
-
+ if (info.evalparam1)
+
#else
- if (evalparam1 (op))
-
+ if (evalparam1 (op))
+
#endif
{
if (!evaluatetree ((**h).param1, &val1))
@@ -1640,12 +1647,12 @@
#ifdef newparams
- if (info.evalparam2)
-
+ if (info.evalparam2)
+
#else
- if (evalparam2 (op))
-
+ if (evalparam2 (op))
+
#endif
{
boolean fl, fltmp;
@@ -1669,7 +1676,7 @@
}
}
}
-
+
langseterrorline (h); /*set globals for error reporting*/
//printf ("evaltree: op = %d/n", op);
@@ -1931,6 +1938,7 @@
langlongparamerror (unexpectedopcodeerror, (long) op);
return (false); /*unimplemented opcode*/
+
} /*evaltree*/
@@ -1946,7 +1954,8 @@
if (!langcheckstackspace ())
return (false);
- return (evaltree (htree, valtree) && !fllangerror);
+ return ( evaltree ( htree, valtree ) && ! fllangerror );
+
} /*evaluatetree*/
@@ -1955,169 +1964,201 @@
#endif
boolean evaluatelist (hdltreenode hfirst, tyvaluerecord *val) {
+
+ //
+ // this is something like the main-event-loop for CanCoon's interpreter.
+ //
+ // chain through a list of statements, evaluating each one and then advance
+ // to the next. the value we return is the value generated by the last
+ // statement in the list.
+ //
+ // we allow an external caller to hand us a pre-stuffed symbol table
+ // through the global hmagictable. we take care of chaining it into the
+ // runtime stack, and releasing it before we exit. the global is reset to
+ // nil, so that it has to be reset on every use.
+ //
+ // 2007-02-23 creedon: support for long odb item names and file paths
+ //
+ // 2001-11-13 dmb: try lazy with evaluation
+ //
+ // 2.1b2 dmb: added langbadexternaloperror check after each evaluatetree
+ //
+ // 1992-09-27 dmb: added languserescaped (false) call inside of loop
+ //
+ // 1992-09-01 dmb: added decent stack overflow detection/handling code
+ //
+ // 1992-02-12 dmb: set lexicalrefcon when pushing local frame. see
+ // langfindsymbol
+ //
+ // 1991-09-23 dmb: magic table handling is now buried a little deeper --
+ // in newhashtable.
+ //
+ // 1991-09-04 dmb: on break and return, make sure langerror isn't missed
+ //
+ // 1990-09-04 DW: Major rewrite -- wrote the Ultimate SuperStresser\xAA
+ // script, and it works!
+ //
+ // 1990-07-23 DW: we have to protect the returned value from being
+ // deallocated as part of the local list's tmp stack. if
+ // it's a string, the caller will get a garbage handle. so
+ // we move the value from the local tmpstack into the
+ // next-most-global tmpstack.
+ //
+ // 1990-07-10 DW: allocate a local table for every level -- it's really
+ // cheap in time, and also cheap in space. this allows
+ // automatic locals to be reliably allocated in the local
+ // space, and may help in the future in making other things
+ // work. now there is one table in the chain for every
+ // level, even if there are no local variables or local
+ // handlers.
+ //
- /*
- this is something like the main-event-loop for CanCoon's interpreter.
+ register boolean fl = false;
+ register hdltreenode programcounter = hfirst;
- chain through a list of statements, evaluating each one and then advance
- to the next. the value we return is the value generated by the last
- statement in the list.
+ hdlhashtable hlocals;
+ boolean flhavelocals, flneedlocals, flneedthis, flReturn = false, fltmpval;
- we allow an external caller to hand us a pre-stuffed symbol table through the
- global hmagictable. we take care of chaining it into the runtime stack, and
- releasing it before we exit. the global is reset to nil, so that it has to
- be reset on every use.
+ #if !lazythis_optimization
- 7/10/90 DW: allocate a local table for every level -- it's really cheap in
- time, and also cheap in space. this allows automatic locals to be reliably
- allocated in the local space, and may help in the future in making other
- things work. now there is one table in the chain for every level, even if
- there are no local variables or local handlers.
+ Handle handleThis = NULL;
+ hdlhashtable hthis;
+
+ #endif
- 7/23/90 DW: we have to protect the returned value from being deallocated
- as part of the local list's tmp stack. if it's a string, the caller will
- get a garbage handle. so we move the value from the local tmpstack into
- the next-most-global tmpstack.
-
- 9/4/90 DW: Major rewrite -- wrote the Ultimate SuperStresser\xAA script, and
- it works!
-
- 9/4/91 dmb: on break and return, make sure langerror isn't missed
-
- 9/23/91 dmb: magic table handling is now buried a little deeper -- in
- newhashtable.
-
- 2/12/92 dmb: set lexicalrefcon when pushing local frame. see langfindsymbol
-
- 9/1/92 dmb: added decent stack overflow detection/handling code
-
- 9/27/92 dmb: added languserescaped (false) call inside of loop
-
- 2.1b2 dmb: added langbadexternaloperror check after each evaluatetree
-
- 11/13/01 dmb: try lazy with evaluation
- */
-
- register hdltreenode programcounter = hfirst;
- register boolean fl = false;
- hdlhashtable hlocals;
- boolean fltmpval;
- boolean flhavelocals, flneedlocals, flneedthis;
-#if !lazythis_optimization
- hdlhashtable hthis;
- bigstring bsthis;
-#endif
-
-
setbooleanvalue (false, val); /*default returned value*/
if (!langcheckstackspace ())
return (false);
-
+
flhavelocals = (**currenthashtable).fllocaltable;
flneedthis = !flhavelocals && (hmagictable == nil);
#if fltryerrorstackcode
+
flneedlocals = !flhavelocals || (hmagictable != nil) || (tryerror != nil) || (tryerrorstack != nil);
+
#else
+
flneedlocals = !flhavelocals || (hmagictable != nil) || (tryerror != nil);
+
#endif
-
+
if (!flneedlocals) { /*pre-scan statement list to see if we need a local frame*/
-
+
register hdltreenode h;
register tytreetype op;
for (h = programcounter; h != nil; h = (**h).link) {
-
+
op = (**h).nodetype;
if ((op == localop) || (op == moduleop)) {
-
+
flneedlocals = true;
break;
+
}
}
}
+
+ if (flneedlocals) {
- if (flneedlocals) {
-
if (!langpushlocalchain (&hlocals))
return (false);
-
+
(**hlocals).lexicalrefcon = langgetlexicalrefcon ();
#ifdef version5orgreater
- if (flneedthis) {
- #if lazythis_optimization
- ++ctdeferredthis;
- #else
- if (langgetthisaddress (&hthis, bsthis))
- langsetthisvalue (hlocals, hthis, bsthis);
- #endif
- }
+
+ if (flneedthis) {
+
+ #if lazythis_optimization
+
+ ++ctdeferredthis;
+ #else
+
+ if ( langgetthisaddress ( &hthis, &handleThis ) )
+ langsetthisvalue ( hlocals, hthis, handleThis );
+ #endif
+
+ }
#endif
if (tryerror != nil) {
-
+
tyvaluerecord errorval;
- if (setheapvalue (tryerror, stringvaluetype, &errorval))
- if (hashassign (nametryerrorval, errorval))
- exemptfromtmpstack (&errorval);
+ if ( setheapvalue ( tryerror, stringvaluetype, &errorval ) ) {
+ /* register */ Handle h;
+
+ newfilledhandle ( nametryerrorval + 1, stringlength ( nametryerrorval ), &h );
+
+ if ( hashassign ( h, errorval ) )
+ exemptfromtmpstack ( &errorval );
+
+ disposehandle ( h );
+
+ }
+
tryerror = nil;
+
}
-
+
#if fltryerrorstackcode
+
if (tryerrorstack != nil) {
-
+
tyvaluerecord errorval;
- // if (setheapvalue (tryerrorstack, listvaluetype, &errorval))
if (setheapvalue (tryerrorstack, stringvaluetype, &errorval))
if (hashassign (nametryerrorstackval, errorval))
exemptfromtmpstack (&errorval);
+
+ tryerrorstack = nil;
- tryerrorstack = nil;
}
#endif
-
+
}
else
hlocals = currenthashtable;
+
+ while (true) { /*visit each statement in the statement list*/
- while (true) { /*visit each statement in the statement list*/
-
if (fllangerror) /*a language error dialog has appeared, unwind*/
break;
+
+ if (programcounter == nil) { /*reached the end of the list*/
- if (programcounter == nil) { /*reached the end of the list*/
-
fl = true; /*don't halt the interpreter*/
break;
+
}
-
+
cleartmpstack (); /*dealloc all outstanding temporary values*/
langseterrorline (programcounter); /*set globals for error reporting*/
if (languserescaped (false)) /*user killed the script*/
break;
-
+
if (!langdebuggercall (programcounter)) /*user killed the script*/
break;
-
+
if (!evaluatetree (programcounter, val))
break;
+
+ #if defined(fldebug) && (fldebug > 1)
- #if defined(fldebug) && (fldebug > 1)
assert (validvalue (val));
assert (!leakingmemory (val));
+
#endif
if (flbreak || flreturn || flcontinue) {
@@ -2125,11 +2166,13 @@
fl = !fllangerror; /*don't halt the interpreter, except on error*/
break;
+
}
+
+ programcounter = (**programcounter).link; /*advance to next statement*/
- programcounter = (**programcounter).link; /*advance to next statement*/
} /*while*/
-
+
/*
1/31/97 dmb: below is the site of a major osamenusharing bug. It can fail!
I've seen it myself. But it's also been reported by Timothy Paustian
@@ -2140,7 +2183,7 @@
*/
if (hlocals != currenthashtable) { /*should never happen*/
-
+
assert (hlocals == currenthashtable); /*context change in background destroyed our state*/
langerror (undefinederror);
@@ -2148,8 +2191,9 @@
currenthashtable = hlocals;
fl = false;
+
}
-
+
/*finished processing list, either natural termination, a break, return or error*/
assert (!fl || !leakingmemory (val));
@@ -2157,31 +2201,44 @@
fltmpval = exemptfromtmpstack (val); /*must survive disposing of local table & background task*/
if (flneedlocals) /*pop the runtime stack*/
+
+ langpoplocalchain (hlocals);
- langpoplocalchain (hlocals);
+ if (fl) /*give agents a shot while val is exempt from temp*/
- if (fl) /*give agents a shot while val is exempt from temp*/
+ fl = langbackgroundtask (false); /*background task can cause termination*/
- fl = langbackgroundtask (false); /*background task can cause termination*/
-
if (fltmpval)
pushtmpstackvalue (val); /*insert into the next-most-global tmpstack*/
+
+ if (!fl) { /*failure of some sort -- return immediately*/
- if (!fl) { /*failure of some sort -- return immediately*/
+ if (flstackoverflow) { /*error was stack overflow*/
- if (flstackoverflow) { /*error was stack overflow*/
-
langcheckstacklimit (idprogramstack, 1, 0); /*report now that stack has been popped a bit */
flstackoverflow = false; /*it's been reported*/
+
}
+
+ goto exit;
- return (false);
}
-
+
if (languserescaped (true)) /*user pressed cmd-period, unwind recursion -- quickly*/
- return (false);
+ goto exit;
+
+ flReturn = true; // fell through the bottom of the list
- return (true); /*fell through the bottom of the list*/
- } /*evaluatelist*/
+ exit:
+
+ #if !lazythis_optimization
+ disposehandle ( handleThis );
+
+ #endif
+
+ return ( flReturn );
+
+ } // evaluatelist
+
Modified: Frontier/branches/Frontier_Long_File_Paths/Common/source/langexternal.c
===================================================================
--- Frontier/branches/Frontier_Long_File_Paths/Common/source/langexternal.c 2007-02-23 21:45:04 UTC (rev 1624)
+++ Frontier/branches/Frontier_Long_File_Paths/Common/source/langexternal.c 2007-02-24 00:04:28 UTC (rev 1625)
@@ -126,22 +126,24 @@
} /*langexternalgettype*/
-static boolean langexternalgetinfo (bigstring bs, hdlhashtable *htable, langvaluecallback *valueroutine) {
+static boolean langexternalgetinfo ( const Handle h, hdlhashtable *htable, langvaluecallback *valueroutine ) {
+
+ //
+ // 2007-02-23 creedon: support for long odb item names and file paths
+ //
+ // a very central bottleneck -- we translate the name of an EFP (something
+ // like "shell" or "wp") into a symbol table and a routine which can be
+ // called to get a function value.
+ //
+ // indicate in flwindow whether the EFP requires that a window be open in
+ // order to evaluate a functionvalue.
+ //
- /*
- a very central bottleneck -- we translate the name of an EFP (something like
- "shell" or "wp") into a symbol table and a routine which can be called to
- get a function value.
-
- indicate in flwindow whether the EFP requires that a window be open in order to
- evaluate a functionvalue.
- */
-
tyvaluerecord val;
register hdlhashtable ht;
hdlhashnode hnode;
- if (!langgetsymbolval (bs, &val, &hnode)) /*has special case for root*/
+ if ( ! langgetsymbolval ( h, &val, &hnode ) ) // has special case for root
return (false);
if (!tablevaltotable (val, htable, hnode))
@@ -152,42 +154,55 @@
*valueroutine = (**ht).valueroutine;
return (true);
+
} /*langexternalgetinfo*/
-boolean langexternalgettable (bigstring bs, hdlhashtable *htable) {
-
+boolean langexternalgettable ( const Handle h, hdlhashtable *htable ) {
+
+ //
+ // 2007-02-23 creedon: support for long odb item names and file paths
+ //
+
langvaluecallback valueroutine;
- return (langexternalgetinfo (bs, htable, &valueroutine));
+ return ( langexternalgetinfo ( h, htable, &valueroutine ) );
+
} /*langexternalgettable*/
boolean langexternalvaltotable (tyvaluerecord val, hdlhashtable *htable, hdlhashnode hnode) {
return (tablevaltotable (val, htable, hnode));
+
} /*langexternalvaltotable*/
-boolean langexternalfindvariable (hdlexternalvariable hv, hdlhashtable *htable, bigstring bsname) {
+boolean langexternalfindvariable ( hdlexternalvariable hv, hdlhashtable *htable, Handle *handleName ) {
+
+ //
+ // 2007-02-23 creedon: support for long odb item names and file paths
+ //
#if langexternalfind_optimization
-
- if (hv != nil && (**hv).hexternaltable != nil && (**hv).hexternalnode != nil) {
-
- *htable = (**hv).hexternaltable;
-
- gethashkey ((**hv).hexternalnode, bsname);
+
+ if (hv != nil && (**hv).hexternaltable != nil && (**hv).hexternalnode != nil) {
- return true;
- }
-
+ *htable = (**hv).hexternaltable;
+
+ gethashkey ( ( **hv ).hexternalnode, handleName );
+
+ return true;
+
+ }
+
#endif
+
+ return ( tablefindvariable ( hv, htable, handleName ) );
+
+ } // langexternalfindvariable
- return (tablefindvariable (hv, htable, bsname));
- } /*langexternalfindvariable*/
-
boolean langexternalgettablevalue (hdltreenode hfirst, short pnum, hdlhashtable *htable) {
return (gettablevalue (hfirst, pnum, htable));
@@ -239,14 +254,14 @@
if (!langgetsymbolval (bsarrayname, &val)) {
- langparamerror (unknownidentifiererror, bsarrayname);
+ langParamErrBs ( unknownidentifiererror, bsarrayname);
return (false);
}
if (val.valuetype != externalvaluetype) {
- langparamerror (notarrayerror, bsarrayname);
+ langParamErrBs ( notarrayerror, bsarrayname);
return (false);
}
@@ -255,14 +270,14 @@
if ((**h).id != idoutlineprocessor) {
- langparamerror (notarrayerror, bsarrayname);
+ langParamErrBs ( notarrayerror, bsarrayname);
return (false);
}
if (!opverbarrayreference ((**h).hdata, ix, &hnode)) {
- langparamerror (arrayreferror, bsarrayname);
+ langParamErrBs ( arrayreferror, bsarrayname);
return (false);
}
@@ -285,41 +300,49 @@
*/
-boolean langsetexternalsymbol (hdlhashtable htable, bigstring bs, tyexternalid id, Handle hdata) {
+boolean langsetexternalsymbol ( hdlhashtable htable, const Handle h, tyexternalid id, Handle hdata ) {
+
+ //
+ // called by an External Function Processor (EFP) to link his data into the
+ // current symboltable. bs is the name of the variable, id tells us who is
+ // responsible for the data, and hdata is the handle we move around to move
+ // the data, and pass back to the EFP when he needs to do something with
+ // it.
+ //
+ //
+ // 2007-02-23 creedon: support for long odb item names and file paths
+ //
- /*
- called by an External Function Processor (EFP) to link his data into the
- current symboltable. bs is the name of the variable, id tells us who is
- responsible for the data, and hdata is the handle we move around to move
- the data, and pass back to the EFP when he needs to do something with it.
- */
+ register boolean fl;
+ register hdlexternalvariable hv = (hdlexternalvariable) hdata;
- register hdlexternalvariable hv = (hdlexternalvariable) hdata;
tyvaluerecord val;
- register boolean fl;
(**hv).id = id;
setexternalvalue ((Handle) hv, &val);
- fl = hashtableassign (htable, bs, val);
+ fl = hashtableassign ( htable, h, val );
return (fl);
- } /*langsetexternalsymbol*/
+
+ } // langsetexternalsymbol
-static boolean langexternalsetsave (hdlhashtable htable, bigstring bs, boolean fldontsave) {
+static boolean langexternalsetsave (hdlhashtable htable, const Handle h, boolean fldontsave) {
+
+ //
+ // set the dont-save bit on the variable whose name is the indicated string.
+ //
+ // 2007-02-23 creedon: support for long odb item names and file paths
+ //
- /*
- set the dont-save bit on the variable whose name is the indicated string.
- */
-
hdlhashnode hnode;
register boolean fl;
pushhashtable (htable);
- fl = langfindsymbol (bs, &htable, &hnode);
+ fl = langfindsymbol (h, &htable, &hnode);
pophashtable ();
@@ -327,35 +350,44 @@
(**hnode).fldontsave = fldontsave;
return (fl);
- } /*langexternalsetsave*/
+ } // langexternalsetsave
-boolean langexternaldontsave (hdlhashtable htable, bigstring bs) {
- /*
- set the dont-save bit on the variable whose name is the indicated string.
- */
+boolean langexternaldontsave ( hdlhashtable htable, const Handle h ) {
+
+ //
+ //set the dont-save bit on the variable whose name is the indicated string.
+ //
+ // 2007-02-23 creedon: support for long odb item names and file paths
+ //
- return (langexternalsetsave (htable, bs, true));
- } /*langexternaldontsave*/
+ return ( langexternalsetsave ( htable, h, true ) );
+ } // langexternaldontsave
-boolean langexternalpl...
[truncated message content] |
