diff options
| -rw-r--r-- | src/ChangeLog | 15 | ||||
| -rw-r--r-- | src/interp/clam.boot | 144 | ||||
| -rw-r--r-- | src/interp/slam.boot | 29 | ||||
| -rw-r--r-- | src/share/doc/msgs/s2-us.msgs | 2 |
4 files changed, 15 insertions, 175 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 5de9d10f..6d1753f5 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,20 @@ 2012-05-05 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/clam.boot (HGETandCount): Remove as unused. + (clearHashReferenceCounts): Likewise. + (remHashEntriesWithCount): Likewise. + (initCache): Likewise. + (assocCache): Likewise. + (assocCacheShift): Likewise. + (assocCacheShiftCount): Likewise. + (hputNewProp): Likewise. + (lassocShift): Likewise. + (lassocShiftQ): Likewise. + (globalHashtableStats): Likewise. + (constructor2ConstructorForm): Likewise. + +2012-05-05 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/clam.boot (compHash): Rework. * interp/spad.lisp ($reportCounts): Remove. diff --git a/src/interp/clam.boot b/src/interp/clam.boot index eecc8fc3..1f34ba58 100644 --- a/src/interp/clam.boot +++ b/src/interp/clam.boot @@ -119,11 +119,6 @@ CDRwithIncrement x == x.first := first x + 1 rest x -HGETandCount(ht,prop) == - u:= tableValue(ht,prop) or return nil - u.first := first u + 1 - u - clearClams() == for [fn,kind,:.] in $clamList | kind = 'hash or integer? kind repeat clearClam fn @@ -212,77 +207,6 @@ mkHashCountAlist vl == al:= [[count,:1],:al] al -clearHashReferenceCounts() == - --free all cells with 0 reference counts; clear other counts to 0 - for x in $clamList repeat - x.cacheType='hash_-tableWithCounts => - remHashEntriesWith0Count eval x.cacheName - x.cacheType='hash_-table => CLRHASH eval x.cacheName - -remHashEntriesWith0Count $hashTable == - MAPHASH(function fn,$hashTable) where fn(key,obj) == - first obj = 0 => tableRemove!($hashTable,key) --free store - nil - -initCache n == - tail:= '(0 . $failed) - l:= [[$failed,:tail] for i in 1..n] - lastNode(l).rest := l - -assocCache(x,cacheName,fn) == - --fn=equality function; do not SHIFT or COUNT - al:= eval cacheName - forwardPointer:= al - val:= nil - until sameObject?(forwardPointer,al) repeat - FUNCALL(fn,CAAR forwardPointer,x) => return (val:= first forwardPointer) - backPointer:= forwardPointer - forwardPointer:= rest forwardPointer - val ~= nil => val - symbolValue(cacheName) := backPointer - nil - -assocCacheShift(x,cacheName,fn) == --like ASSOC except that al is circular - --fn=equality function; SHIFT but do not COUNT - al:= eval cacheName - forwardPointer:= al - val:= nil - until sameObject?(forwardPointer,al) repeat - FUNCALL(fn, first (y:=first forwardPointer),x) => - if not sameObject?(forwardPointer,al) then --shift referenced entry to front - forwardPointer.first := first al - al.first := y - return (val:= y) - backPointer := forwardPointer --first is slot replaced on failure - forwardPointer:= rest forwardPointer - val => val - symbolValue(cacheName) := backPointer - nil - -assocCacheShiftCount(x,al,fn) == - -- if x is found, entry containing x becomes first element of list; if - -- x is not found, entry with smallest use count is shifted to front so - -- as to be replaced - --fn=equality function; COUNT and SHIFT - forwardPointer:= al - val:= nil - minCount:= 10000 --preset minCount but not newFrontPointer here - until sameObject?(forwardPointer,al) repeat - FUNCALL(fn, first (y:=first forwardPointer),x) => - newFrontPointer := forwardPointer - y.rest.first := second y + 1 --increment use count - return (val:= y) - c := second y - if c < minCount then --initial c is 1 so is true 1st time - minCount := c - newFrontPointer := forwardPointer --CAR is slot replaced on failure - forwardPointer:= rest forwardPointer - if not sameObject?(newFrontPointer,al) then --shift referenced entry to front - temp:= first newFrontPointer --or entry with smallest count - newFrontPointer.first := first al - al.first := temp - val - clamStats() == for [op,kind,:.] in $clamList repeat cacheVec:= property(op,'cacheInfo) or systemErrorHere ["clamStats",op] @@ -373,22 +297,6 @@ reportInstantiations() == '" ",mTotal,'" dropped","%l", '" ",nForms,'" distinct domains instantiated/dropped"] -hputNewProp(ht,op,argList,val) == - --NOTE: obselete if lines *** are commented out - -- Warning!!! This function should only be called for - -- $ConstructorCache slamming --- since it maps devaluate onto prop, an - -- argument list - -- - -- This function may be called when property is already there; for - -- example, Polynomial applied to '(Integer), not finding it in the - -- cache will invoke Polynomial to compute it; inside of Polynomial is - -- a call to this function which will hputNewProp the property onto the - -- cache so that when this function is called by the outer Polynomial, - -- the value will always be there - - prop:= [devaluate x for x in argList] - haddProp(ht,op,prop,val) - listTruncate(l,n) == u:= l n:= n - 1 @@ -401,18 +309,6 @@ listTruncate(l,n) == u.rest := nil l -lassocShift(x,l) == - y:= l - while cons? y repeat - x = first first y => return (result := first y) - y:= rest y - result => - if not sameObject?(y,l) then - y.first := first l - l.first := result - rest result - nil - lassocShiftWithFunction(x,l,fn) == y:= l while cons? y repeat @@ -425,46 +321,6 @@ lassocShiftWithFunction(x,l,fn) == rest result nil -lassocShiftQ(x,l) == - y:= l - while cons? y repeat - sameObject?(x,first first y) => return (result := first y) - y:= rest y - result => - if not sameObject?(y,l) then - y.first := first l - l.first := result - rest result - nil - --- rassocShiftQ(x,l) == --- y:= l --- while cons? y repeat --- sameObject?(x,rest first y) => return (result := first y) --- y:= rest y --- result => --- if not sameObject?(y,l) then --- y.first := first l --- l.first := result --- first result --- nil - -globalHashtableStats(x,sortFn) == - --assumed to be a hashtable with reference counts - for [key,:u] in entries x repeat - for [argList,n,:.] in u repeat - not integer? n => keyedSystemError("S2GE0013",[x]) - argList1:= [constructor2ConstructorForm x for x in argList] - reportList:= [[n,key,argList1],:reportList] - sayBrightly ["%b"," USE NAME ARGS","%d"] - for [n,fn,args] in sortBy(sortFn,reportList) repeat - sayBrightlyNT [:rightJustifyString(n,6)," ",fn,": "] - pp args - -constructor2ConstructorForm x == - vector? x => x.0 - x - rightJustifyString(x,maxWidth) == size:= entryWidth x size > maxWidth => keyedSystemError("S2GE0014",[x]) diff --git a/src/interp/slam.boot b/src/interp/slam.boot index 3a1c0bba..c48b0cbf 100644 --- a/src/interp/slam.boot +++ b/src/interp/slam.boot @@ -356,35 +356,6 @@ recurrenceError(op,arg) == throwKeyedMsg("S2IX0002",[op,arg]) mkCacheVec(op,nam,kind,resetCode,countCode) == [op,nam,kind,resetCode,countCode] --- reportCacheStore vl == --- sayMSG concat(centerString('"Name",22,'" ")," Kind #Cells") --- sayMSG concat(centerString('"----",22,'" ")," ---- ------") --- for x in vl repeat reportCacheStoreFor x --- --- op2String op == --- u:= linearFormatName op --- u isnt [.,:.] => PNAME u --- strconc/u --- --- reportCacheStorePrint(op,kind,count) == --- ops:= op2String op --- opString:= centerString(ops,22,'" ") --- kindString:= centerString(PNAME kind,10,'" ") --- countString:= centerString(count,19,'" ") --- sayMSG concat(opString,kindString,countString) --- --- reportCacheStoreFor op == --- u:= getI(op,'localModemap) => --- for [['local,target,:.],[.,fn],:.] in u repeat --- [op1,cacheName,kind,.,countCode]:= getI(fn,'cacheInfo) or --- keyedSystemError("S2GE0016",['"reportCacheStoreFor", --- '"missing cache information vector"]) --- reportCacheStorePrint(op,kind,eval countCode) --- true --- u:= getI(op,"cache") => --- reportCacheStorePrint(op,'variable,nodeCount u) --- nil - ++ We are about to clear local modemaps associated with `x'. ++ It is insufficient to just remove the internal functions ++ form the 'localModemap property list in the current environment. diff --git a/src/share/doc/msgs/s2-us.msgs b/src/share/doc/msgs/s2-us.msgs index c5e1ef48..ffb1af0f 100644 --- a/src/share/doc/msgs/s2-us.msgs +++ b/src/share/doc/msgs/s2-us.msgs @@ -1066,8 +1066,6 @@ S2GE0002 S2GE0003 The cache for %1b cannot be cleared because that function is not privately clammed. -S2GE0013 - %1b has the wrong format: the reference counts are missing. S2GE0014 %1b is too large S2GE0015 |