You are viewing a plain text version of this content. The canonical link for it is here.
Posted to embperl-cvs@perl.apache.org by ri...@locus.apache.org on 2000/10/18 15:28:58 UTC
cvs commit: embperl embperl.h ep.h epcomp.c epdat.h epdom.h epeval.c epmacro.h epmain.c test.pl
richter 00/10/18 06:28:58
Modified: . Tag: Embperl2c embperl.h ep.h epcomp.c epdat.h
epdom.h epeval.c epmacro.h epmain.c test.pl
Log:
Embperl 2 - Processor pipes
Revision Changes Path
No revision
No revision
1.19.4.2 +1 -0 embperl/embperl.h
Index: embperl.h
===================================================================
RCS file: /home/cvs/embperl/embperl.h,v
retrieving revision 1.19.4.1
retrieving revision 1.19.4.2
diff -u -r1.19.4.1 -r1.19.4.2
--- embperl.h 2000/10/17 12:55:43 1.19.4.1
+++ embperl.h 2000/10/18 13:28:52 1.19.4.2
@@ -106,6 +106,7 @@
dbgBuildToken = 0x800000,
dbgParse = 0x1000000,
dbgObjectSearch = 0x2000000,
+ dbgCache = 0x4000000,
dbgAll = -1
} ;
1.27.4.5 +6 -0 embperl/ep.h
Index: ep.h
===================================================================
RCS file: /home/cvs/embperl/ep.h,v
retrieving revision 1.27.4.4
retrieving revision 1.27.4.5
diff -u -r1.27.4.4 -r1.27.4.5
--- ep.h 2000/10/18 06:51:46 1.27.4.4
+++ ep.h 2000/10/18 13:28:52 1.27.4.5
@@ -464,6 +464,12 @@
/* ---- from epeval.c ----- */
+int CallCV (/*i/o*/ register req * r,
+ /*in*/ const char * sArg,
+ /*in*/ CV * pSub,
+ /*in*/ int flags,
+ /*out*/ SV ** pRet) ;
+
int EvalOnly (/*i/o*/ register req * r,
/*in*/ const char * sArg,
/*in*/ SV ** ppSV,
1.4.2.8 +137 -51 embperl/Attic/epcomp.c
Index: epcomp.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epcomp.c,v
retrieving revision 1.4.2.7
retrieving revision 1.4.2.8
diff -u -r1.4.2.7 -r1.4.2.8
--- epcomp.c 2000/10/18 06:51:46 1.4.2.7
+++ epcomp.c 2000/10/18 13:28:52 1.4.2.8
@@ -1241,9 +1241,17 @@
STRLEN l ;
SV * pSV ;
SV * args[2] ;
-
+ SV ** ppLastResult = (ppCompResult && *ppCompResult?ppCompResult:ppPreCompResult) ;
+
r -> nPhase = phCompile ;
+ if (ppLastResult && SvTYPE (*ppLastResult) == SVt_PVCV)
+ { /* Get already parsed Dom Tree */
+ if (ppCompResult != ppLastResult)
+ AssignSVPtr (ppCompResult,*ppLastResult) ;
+ return ok ;
+ }
+
StringNew (&pProgRun, r -> Buf.pFile -> nFilesize / 4) ;
StringNew (&pProgDef, r -> Buf.pFile -> nFilesize / 4) ;
pProg = &pProgRun ;
@@ -1337,27 +1345,40 @@
tDomTree * pDomTree ;
clock_t cl1 = clock () ;
clock_t cl2 ;
+ SV ** ppLastResult = (ppCompResult && *ppCompResult?ppCompResult:ppPreCompResult) ;
r -> nPhase = phParse ;
- if ((rc = ParseFile (r)) != ok)
- {
- return rc ;
- }
-
- pDomTree = DomTree_self (r -> xCurrDomTree) ;
- *ppDomTree = pDomTree ;
- *ppCompResult = pDomTree -> pDomTreeSV ;
+ if (ppLastResult && SvIOKp (*ppLastResult))
+ { /* Get already parsed Dom Tree */
+ pDomTree = DomTree_selfSV(*ppLastResult) ;
+ if (ppCompResult != ppLastResult)
+ AssignSVPtr (ppCompResult,*ppLastResult) ;
+ }
+ else
+ {
+ if ((rc = ParseFile (r)) != ok)
+ {
+ return rc ;
+ }
- cl2 = clock () ;
+ pDomTree = DomTree_self (r -> xCurrDomTree) ;
+ AssignSVPtr (ppCompResult,SV_DomTree_self (pDomTree)) ;
+ SvREFCNT_inc (*ppCompResult) ;
+
+ cl2 = clock () ;
#ifdef CLOCKS_PER_SEC
- if (r -> bDebug)
- {
- lprintf (r, "[%d]PERF: Parse Start Time: %d ms \n", r -> nPid, ((cl1 - r -> startclock) * 1000 / CLOCKS_PER_SEC)) ;
- lprintf (r, "[%d]PERF: Parse End Time: %d ms \n", r -> nPid, ((cl2 - r -> startclock) * 1000 / CLOCKS_PER_SEC)) ;
- lprintf (r, "[%d]PERF: Parse Time: %d ms \n", r -> nPid, ((cl2 - cl1) * 1000 / CLOCKS_PER_SEC)) ;
- }
+ if (r -> bDebug)
+ {
+ lprintf (r, "[%d]PERF: Parse Start Time: %d ms \n", r -> nPid, ((cl1 - r -> startclock) * 1000 / CLOCKS_PER_SEC)) ;
+ lprintf (r, "[%d]PERF: Parse End Time: %d ms \n", r -> nPid, ((cl2 - r -> startclock) * 1000 / CLOCKS_PER_SEC)) ;
+ lprintf (r, "[%d]PERF: Parse Time: %d ms \n", r -> nPid, ((cl2 - cl1) * 1000 / CLOCKS_PER_SEC)) ;
+ }
#endif
+ }
+
+ *ppDomTree = pDomTree ;
+
return ok ;
}
@@ -1387,6 +1408,9 @@
clock_t cl2 ;
SV * pSV ;
+ if (ppExecResult && SvIOKp (*ppExecResult))
+ return ok ;
+
if (!r -> bError)
{
char * sSubName = r -> sSubName ;
@@ -1456,7 +1480,9 @@
return rc ;
*pDomTree = pCurrDomTree ;
- }
+ AssignSVPtr (ppExecResult, SV_DomTree_self (pCurrDomTree)) ;
+ SvREFCNT_inc (*ppExecResult) ;
+ }
r -> nPhase = phTerm ;
@@ -1469,9 +1495,14 @@
/* */
/* See if this step is already in the cache and is valid */
/* */
-/* in pProcessor Processor to check for */
+/* in pProcessor Processor to check for */
/* cType Type with should checked */
-/* out ppSV Cached value (or undef to store new value) */
+/* nExpiresIn -1 imideately */
+/* 0 never (only is preceeding steps are expires) */
+/* <n> second */
+/* pExiresCV Exipres when CV return true */
+/* bForceExpire When set to true entry is unconditional expired */
+/* out ppSV Cached value (or undef to store new value) */
/* */
/* ------------------------------------------------------------------------ */
@@ -1479,19 +1510,56 @@
int embperl_GetFromCache (/*in*/ tReq * r,
/*in*/ tProcessor * pProcessor,
/*in*/ char cType,
+ /*in*/ double nExpiresIn,
+ /*in*/ CV * pExpiresCV,
+ /*in*/ int * bForceExpire,
/*out*/ SV * * * pppSV)
{
- char sKey[20] ;
- int nKey = sprintf (sKey, "%c%d", cType, pProcessor -> nProcessorNo) ;
+ int rc ;
+ char sKey[255] ;
+ int nKey ;
SV * * ppSV ;
STRLEN l ;
+
+ if (nExpiresIn == -1)
+ {
+ *pppSV = (SV**)_malloc (r, sizeof (SV *)) ;
+ **pppSV = NULL ;
+ if (r -> bDebug & dbgCache)
+ lprintf (r, "[%d]CACHE: Type '%c' not cached\n", r -> nPid, cType) ;
+ return ok ;
+ }
+
+ nKey = sprintf (sKey, "%c-%d-%0.200s", cType, pProcessor -> nProcessorNo, pProcessor -> sCacheKey) ;
+ if (r -> bDebug & dbgCache)
+ lprintf (r, "[%d]CACHE: Key is '%s'\n", r -> nPid, sKey) ;
*pppSV = ppSV = hv_fetch(r -> Buf.pFile -> pCacheHash, sKey, nKey, 1) ;
if (ppSV == NULL || *ppSV == NULL)
return rcHashError ;
+ if (*bForceExpire)
+ { // Expire the entry
+ sv_setsv (*ppSV, &sv_undef) ;
+ if (r -> bDebug & dbgCache)
+ lprintf (r, "[%d]CACHE: Expired because entry depends other expired entry\n", r -> nPid) ;
+ }
+ else if (nExpiresIn > 0)
+ {
+ double nTimestamp = SvNOKp(*ppSV)?SvNVX(*ppSV):0 ;
+
+ if (nTimestamp + nExpiresIn <= time (NULL))
+ { // Expire the entry
+ sv_setsv (*ppSV, &sv_undef) ;
+ *bForceExpire = 1 ;
+ if (r -> bDebug & dbgCache)
+ lprintf (r, "[%d]CACHE: Expired because of timeout (%f sec)\n", r -> nPid, nExpiresIn) ;
+ }
+
+ }
+
if (*ppSV != NULL && SvTYPE (*ppSV) == SVt_PV)
{
strncpy (r -> errdat1, SvPV(*ppSV, l), sizeof (r -> errdat1) - 1) ;
@@ -1519,11 +1587,27 @@
r -> Buf.pCurrPos = NULL ;
r -> Buf.nSourceline = 0 ;
return SvIVX(*ppSV) ;
+ }
+ else if (pExpiresCV)
+ {
+ SV * pRet ;
+
+ if ((rc = CallCV (r, "Expired?", pExpiresCV, 0, &pRet)) != ok)
+ return rc ;
+
+ if (pRet && SvOK(pRet))
+ { // Expire the entry
+ sv_setsv (*ppSV, &sv_undef) ;
+ *bForceExpire = 1 ;
+ if (r -> bDebug & dbgCache)
+ lprintf (r, "[%d]CACHE: Expired because Expirey sub returned TRUE\n", r -> nPid) ;
+ }
}
- else if (*ppSV == NULL || !SvIOKp (*ppSV) )
- {
- if (*ppSV)
- SvREFCNT_dec (*ppSV) ;
+ else if (nExpiresIn > 0)
+ { /* add timestamp */
+ SvUPGRADE (*ppSV, SVt_PVNV) ;
+ SvNVX (*ppSV) = time (NULL) ;
+ SvNOK_on (*ppSV) ;
}
return ok ;
@@ -1557,34 +1641,37 @@
clock_t cl3 ;
clock_t cl4 ;
tProcessor * pProcessor = NULL ;
+ int bForceExpire ;
+ int bForceExpirePre ;
tainted = 0 ;
cl2 = clock () ;
pProcessor = pFirstProcessor ;
+ bForceExpirePre = 0 ;
pDomTree = DomTree_self (r -> xCurrDomTree) ;
- while (pProcessor)
+ while (pProcessor && !r -> bError)
{
if (pProcessor -> pPreCompiler)
{
- if ((rc = embperl_GetFromCache (r, pProcessor, 'P', &ppSV)) != ok)
+ if ((rc = embperl_GetFromCache (r, pProcessor, 'P', 0, NULL, &bForceExpirePre, &ppSV)) != ok)
return rc ;
- if (!SvIOKp (*ppSV))
+ if ((rc = (*pProcessor -> pPreCompiler)(r, pProcessor, &pDomTree, NULL, ppSV)) != ok)
{
- if ((rc = (*pProcessor -> pPreCompiler)(r, pProcessor, &pDomTree, NULL, ppSV)) != ok)
- {
- *ppSV = newSVpvf ("%s\t%s", r -> errdat1, r -> errdat2) ;
+ if (!r -> bError)
+ {
+ *ppSV = newSVpvf ("%s\t%s", r -> errdat1, r -> errdat2) ;
SvUPGRADE (*ppSV, SVt_PVIV) ;
- SvIVX (*ppSV) = rc ;
- if (r -> xCurrDomTree)
- {
- DomTree_delete(DomTree_self(r -> xCurrDomTree)) ;
- r -> xCurrDomTree = 0 ;
- }
- return rc ;
+ SvIVX (*ppSV) = rc ;
+ }
+ if (r -> xCurrDomTree)
+ {
+ DomTree_delete(DomTree_self(r -> xCurrDomTree)) ;
+ r -> xCurrDomTree = 0 ;
}
+ return rc ;
}
}
pProcessor = pProcessor -> pNext ;
@@ -1594,6 +1681,8 @@
{
pProcessor = pFirstProcessor ;
+ bForceExpire = 0 ;
+ bForceExpirePre = 0 ;
while (pProcessor && !r -> bError)
{
SV ** ppPreCompResult = NULL ;
@@ -1602,37 +1691,34 @@
if (pProcessor -> pPreCompiler)
{
- if ((rc = embperl_GetFromCache (r, pProcessor, 'P', &ppPreCompResult)) != ok)
+ if ((rc = embperl_GetFromCache (r, pProcessor, 'P', 0, NULL, &bForceExpirePre, &ppPreCompResult)) != ok)
return rc ;
}
if (pProcessor -> pCompiler)
{
- if ((rc = embperl_GetFromCache (r, pProcessor, 'C', &ppCompResult)) != ok)
+ if ((rc = embperl_GetFromCache (r, pProcessor, 'C', 0, NULL, &bForceExpire, &ppCompResult)) != ok)
return rc ;
- if (!SvIOKp (*ppCompResult))
- {
- if ((rc = (*pProcessor -> pCompiler)(r, pProcessor, &pDomTree, ppPreCompResult, ppCompResult)) != ok)
- return rc ;
- }
+ if ((rc = (*pProcessor -> pCompiler)(r, pProcessor, &pDomTree, ppPreCompResult, ppCompResult)) != ok)
+ return rc ;
}
if (!r -> bError && pProcessor -> pExecuter)
{
- if ((rc = embperl_GetFromCache (r, pProcessor, 'E', &ppExecResult)) != ok)
+ if ((rc = embperl_GetFromCache (r, pProcessor, 'E', pProcessor -> nOutputExpiresIn, pProcessor -> pOutputExpiresCV, &bForceExpire, &ppExecResult)) != ok)
return rc ;
- if (!SvIOKp (*ppExecResult))
- {
- if ((rc = (*pProcessor -> pExecuter)(r, pProcessor, &pDomTree, ppPreCompResult, ppCompResult, ppExecResult)) != ok)
- return rc ;
- }
+ if ((rc = (*pProcessor -> pExecuter)(r, pProcessor, &pDomTree, ppPreCompResult, ppCompResult, ppExecResult)) != ok)
+ return rc ;
+ if (ppExecResult)
+ r -> xCurrDomTree = DomTree_SV (*ppExecResult) ;
}
pProcessor = pProcessor -> pNext ;
}
}
+
r -> nPhase = phTerm ;
1.20.4.5 +5 -0 embperl/epdat.h
Index: epdat.h
===================================================================
RCS file: /home/cvs/embperl/epdat.h,v
retrieving revision 1.20.4.4
retrieving revision 1.20.4.5
diff -u -r1.20.4.4 -r1.20.4.5
--- epdat.h 2000/10/18 06:51:47 1.20.4.4
+++ epdat.h 2000/10/18 13:28:53 1.20.4.5
@@ -41,6 +41,11 @@
/*in*/ SV ** ppPreCompResult,
/*in*/ SV ** ppCompResult,
/*out*/ SV ** ppExecResult) ;
+
+ const char * sCacheKey ;
+ double nOutputExpiresIn ;
+ CV * pOutputExpiresCV ;
+
struct tProcessor * pNext ;
} tProcessor ;
1.4.2.4 +5 -0 embperl/Attic/epdom.h
Index: epdom.h
===================================================================
RCS file: /home/cvs/embperl/Attic/epdom.h,v
retrieving revision 1.4.2.3
retrieving revision 1.4.2.4
diff -u -r1.4.2.3 -r1.4.2.4
--- epdom.h 2000/09/26 19:31:59 1.4.2.3
+++ epdom.h 2000/10/18 13:28:53 1.4.2.4
@@ -255,6 +255,11 @@
int DomTree_discardAfterCheckpoint (/*in*/ tIndex xDomTree,
/*in*/ tNode xNode) ;
+#define DomTree_SV(pSV) SvIVX(pSV)
+#define DomTree_selfSV(pSV) (DomTree_self(SvIVX(pSV)))
+#define SV_DomTree(xDomTree) (DomTree_self (xDomTree) -> pDomTreeSV)
+#define SV_DomTree_self(pDomTree) (pDomTree -> pDomTreeSV)
+
tNode Node_appendChild (/*in*/ tDomTree * pDomTree,
/*in*/ tNodeType nType,
/*in*/ int bForceAttrValue,
1.23.4.3 +1 -1 embperl/epeval.c
Index: epeval.c
===================================================================
RCS file: /home/cvs/embperl/epeval.c,v
retrieving revision 1.23.4.2
retrieving revision 1.23.4.3
diff -u -r1.23.4.2 -r1.23.4.3
--- epeval.c 2000/10/18 06:51:47 1.23.4.2
+++ epeval.c 2000/10/18 13:28:53 1.23.4.3
@@ -306,7 +306,7 @@
------------------------------------------------------------------------------- */
-static int CallCV (/*i/o*/ register req * r,
+int CallCV (/*i/o*/ register req * r,
/*in*/ const char * sArg,
/*in*/ CV * pSub,
/*in*/ int flags,
1.6.4.1 +5 -0 embperl/epmacro.h
Index: epmacro.h
===================================================================
RCS file: /home/cvs/embperl/epmacro.h,v
retrieving revision 1.6
retrieving revision 1.6.4.1
diff -u -r1.6 -r1.6.4.1
--- epmacro.h 2000/09/11 09:53:30 1.6
+++ epmacro.h 2000/10/18 13:28:53 1.6.4.1
@@ -104,3 +104,8 @@
#define EPENTRY1N(func,arg1)
#define EPENTRY1S(func,arg1)
#endif
+
+
+
+#define AssignSVPtr(ppDst,pSrc) { if (*ppDst) SvREFCNT_dec (*ppDst) ; *ppDst = pSrc ; }
+
1.75.4.6 +2 -2 embperl/epmain.c
Index: epmain.c
===================================================================
RCS file: /home/cvs/embperl/epmain.c,v
retrieving revision 1.75.4.5
retrieving revision 1.75.4.6
diff -u -r1.75.4.5 -r1.75.4.6
--- epmain.c 2000/10/18 06:51:47 1.75.4.5
+++ epmain.c 2000/10/18 13:28:53 1.75.4.6
@@ -2879,8 +2879,8 @@
#ifdef EP2
if (!r -> bEP1Compat)
{
- tProcessor p2 = {2, embperl_CompileProcessor, NULL, embperl_ExecuteProcessor, NULL } ;
- tProcessor p1 = {1, embperl_ParseProcessor, NULL, NULL, &p2 } ;
+ tProcessor p2 = {2, embperl_CompileProcessor, NULL, embperl_ExecuteProcessor, "", 0, NULL, NULL } ;
+ tProcessor p1 = {1, embperl_ParseProcessor, NULL, NULL, "", 0, NULL, &p2 } ;
rc = embperl_CompileDocument (r, &p1) ;
}
1.70.4.11 +4 -2 embperl/test.pl
Index: test.pl
===================================================================
RCS file: /home/cvs/embperl/test.pl,v
retrieving revision 1.70.4.10
retrieving revision 1.70.4.11
diff -u -r1.70.4.10 -r1.70.4.11
--- test.pl 2000/10/17 12:55:44 1.70.4.10
+++ test.pl 2000/10/18 13:28:53 1.70.4.11
@@ -119,7 +119,9 @@
'query_info' => 'sel=2&SEL1=B&SEL3=D&SEL4=cc',
},
'mix.htm' => { },
- 'binary.htm' => { },
+ 'binary.htm' => {
+ 'version' => 1, # needs print OUT
+ },
'nesting.htm' => {
'version' => 1,
},
@@ -683,7 +685,7 @@
print "\nloading... ";
- $defaultdebug = 0x3f85ffd ;
+ $defaultdebug = 0x7f85ffd ;
#$defaultdebug = 1 ;
#### setup paths #####