diff options
| -rw-r--r-- | src/ChangeLog | 11 | ||||
| -rw-r--r-- | src/interp/c-util.boot | 10 | ||||
| -rw-r--r-- | src/interp/clam.boot | 160 | ||||
| -rw-r--r-- | src/interp/define.boot | 2 | ||||
| -rw-r--r-- | src/interp/sys-globals.boot | 14 | ||||
| -rw-r--r-- | src/share/doc/msgs/s2-us.msgs | 26 |
6 files changed, 36 insertions, 187 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 235c92bd..4f3ddfee 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,14 @@ +2012-05-05 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * interp/clam.boot (compClam): Remove. + (compHash): Simplify. Now take only 3 parameters. + * interp/c-util.boot (compileQuietly): Remove as unused. + * interp/sys-globals.boot ($clamList): Move to clam.boot. + * interp/define.boot (compileConstructor1): Call compHash in lieu + of compClam. + * share/doc/msgs/s2-us.msgs: Remove unused diagnostics, due to + compClam removal and compHash simplification. + 2012-05-04 Gabriel Dos Reis <gdr@cs.tamu.edu> * interp/define.boot (compileConstructor1): Don't call diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index e43cd164..72a75537 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -1768,16 +1768,6 @@ compQuietly fn == "PRINT-DEFUN" quietlyIfInteractive backendCompile fn -compileQuietly fn == - _*COMP370_-APPLY_* := - $InteractiveMode => - $compileDontDefineFunctions => "COMPILE-DEFUN" - "EVAL-DEFUN" - "PRINT-DEFUN" - quietlyIfInteractive COMP370 fn - - - COMP370 x == first x is [.,:.] => [COMPILE1 y for y in x] [COMPILE1 x] diff --git a/src/interp/clam.boot b/src/interp/clam.boot index 64d9fc14..ef934368 100644 --- a/src/interp/clam.boot +++ b/src/interp/clam.boot @@ -65,112 +65,26 @@ namespace BOOT -- entries have their use count set -- to 0 on garbage collection; those with 0 use count at garbage collection -- are cleared --- see definition of backendCompile2 in c-util which calls clamComp below + +++ +$clamList == + '((canCoerce hash UEQUAL count) _ + (canCoerceFrom hash UEQUAL count) _ + (coerceConvertMmSelection hash UEQUAL count) _ + (isLegitimateMode hash UEQUAL count) _ + (isValidType hash UEQUAL count) _ + (resolveTT hash UEQUAL count) _ + (selectMms1 hash UEQUAL count) _ + (underDomainOf hash UEQUAL count)) ++ $failed := '"failed" -compClam(op,argl,body,$clamList) == - --similar to reportFunctionCompilation in SLAM BOOT - if $InteractiveMode then startTimingProcess 'compilation - if (u := symbolTarget(op,$clamList)) isnt [kind,eqEtc,:options] - then keyedSystemError("S2GE0004",[op]) - $clamList:= nil --clear to avoid looping - if u:= S_-(options,'(shift count)) then - keyedSystemError("S2GE0006",[op,:u]) - shiftFl := 'shift in options - countFl := 'count in options - if #argl > 1 and eqEtc= 'EQ then - keyedSystemError("S2GE0007",[op]) - (not ident? kind) and (not integer? kind or kind < 1) => - keyedSystemError("S2GE0005",[op]) - ident? kind => - shiftFl => keyedSystemError("S2GE0008",[op]) - compHash(op,argl,body,(kind='hash => nil; kind),eqEtc,countFl) - cacheCount:= kind - if argl = nil then keyedSystemError("S2GE0009",[op]) - phrase:= - cacheCount=1 => ['"computed value only"] - [:bright cacheCount,'"computed values"] - sayBrightly [:bright op,'"will save last",:phrase] - auxfn:= makeSymbol strconc(op,'";") - g1:= gensym() --argument or argument list - [arg,computeValue] := - argl is [.] => [[g1],[auxfn,g1]] --g1 is a parameter - [g1,['APPLY,['function,auxfn],g1]] --g1 is a parameter list - cacheName:= mkCacheName op - if $reportCounts then - hitCounter:= makeSymbol strconc(op,'";hit") - callCounter:= makeSymbol strconc(op,'";calls") - symbolValue(hitCounter) := 0 - symbolValue(callCounter) := 0 - callCountCode:= [['%store,callCounter,['%iinc,callCounter]]] - hitCountCode:= [['%store,hitCounter,['%iinc,hitCounter]]] - g2:= gensym() --length of cache or arg-value pair - g3:= gensym() --value computed by calling function - lookUpFunction:= - shiftFl => - countFl => 'assocCacheShiftCount - 'assocCacheShift - countFl => 'assocCacheCount - 'assocCache - returnFoundValue:= - countFl => ['CDDR,g3] - ['%tail,g3] - namePart:= - countFl => cacheName - MKQ cacheName - secondPredPair:= - [['%store,g3,[lookUpFunction,g1,namePart,eqEtc]], - :hitCountCode, - returnFoundValue] - resetCacheEntry:= - countFl => ['%pair,1,g2] - g2 - thirdPredPair:= - ['%otherwise, - ['%store,g2,computeValue], - ['%store,g3,['%head,cacheName]], - ['%store,['%head,g3],g1], - ['%store,['%tail,g3],resetCacheEntry], - g2] - codeBody:= ['PROG,[g2,g3], - :callCountCode, - ['RETURN,['%when,secondPredPair,thirdPredPair]]] - mainFunction:= [op,['LAMBDA,arg,codeBody]] - computeFunction:= [auxfn,['LAMBDA,argl,:body]] - - -- compile generated function stub - compileInteractive mainFunction - - -- compile main body: this has already been compTran'ed - if $reportCompilation then - sayBrightlyI bright '"Generated LISP code for function:" - pp computeFunction - compileQuietly [computeFunction] - - cacheType:= 'function - cacheResetCode:= ['%store,cacheName,['initCache,cacheCount]] - cacheCountCode:= ['countCircularAlist,cacheName,cacheCount] - cacheVector:= mkCacheVec(op,cacheName,cacheType, - cacheResetCode,cacheCountCode) - LAM_,EVALANDFILEACTQ ['PUT, MKQ op, MKQ 'cacheInfo, MKQ cacheVector] - LAM_,EVALANDFILEACTQ cacheResetCode - if $InteractiveMode then stopTimingProcess 'compilation - op - -compHash(op,argl,body,cacheNameOrNil,eqEtc,countFl) == +compHash(op,argl,body) == -- Entries will be stored on the global hashtable in a uniform way: -- (<argument list>, <reference count>,:<value>) -- where the reference count is optional - if cacheNameOrNil and cacheNameOrNil ~= '_$ConstructorCache then - keyedSystemError("S2GE0010",[op]) - --restriction due to omission of call to hputNewValue (see *** lines below) - - argl = nil and cacheNameOrNil = nil => keyedSystemError("S2GE0011",[op]) - cacheNameOrNil = nil and not (eqEtc in '(EQ EQL EQUAL CVEC UEQUAL)) => - keyedSystemError("S2GE0012",[op]) auxfn := makeWorkerName op g1 := --argument or argument list argl = nil => nil @@ -182,11 +96,11 @@ compHash(op,argl,body,cacheNameOrNil,eqEtc,countFl) == -- computeValue: the form used to compute the value from arg argl = nil => [nil,nil,[auxfn]] argl is [.] => - key := (cacheNameOrNil => ['devaluate,g1]; g1) + key := ['devaluate,g1] [argl,['%list,key],[auxfn,g1]] --g1 is a parameter - key:= (cacheNameOrNil => ['devaluateList,g1] ; g1) + key := ['devaluateList,g1] [g1,key,['APPLY,['function,auxfn],g1]] --g1 is a parameter list - cacheName:= cacheNameOrNil or mkCacheName op + cacheName := "$ConstructorCache" if $reportCounts then hitCounter:= makeSymbol strconc(op,'";hit") callCounter:= makeSymbol strconc(op,'";calls") @@ -201,33 +115,19 @@ compHash(op,argl,body,cacheNameOrNil,eqEtc,countFl) == -- stored in the same format as those with several arguments, e.g. -- to cache the value <val> given by f(), the structure -- ((nil <count> <val>)) is stored in the cache - countFl => ['CDRwithIncrement,['CDAR,g2]] - ['CDAR,g2] - countFl => ['CDRwithIncrement,g2] - g2 + ['CDRwithIncrement,['CDAR,g2]] + ['CDRwithIncrement,g2] getCode:= argl = nil => ['tableValue,cacheName,MKQ op] - cacheNameOrNil => - eqEtc ~= 'EQUAL => - ['lassocShiftWithFunction,cacheArgKey, - ['tableValue,cacheNameOrNil,MKQ op],['%function,eqEtc]] - ['lassocShift,cacheArgKey,['tableValue,cacheNameOrNil,MKQ op]] - ['tableValue,cacheName,g1] + ['lassocShiftWithFunction,cacheArgKey, + ['tableValue,cacheName,MKQ op],['%function,'domainEqualList]] secondPredPair:= [g2,mkSeq [:hitCountCode,returnFoundValue]] putCode:= argl = nil => - cacheNameOrNil => - countFl => - ['CDDAR,['%store,['tableValue,cacheNameOrNil,MKQ op], - ['%list,['%pair,'%nil,['%pair,1,computeValue]]]]] - ['%store,['tableValue,cacheNameOrNil,MKQ op], - ['%list,['%pair,'%nil,computeValue]]] - systemError '"unexpected" - cacheNameOrNil => computeValue - countFl => - ['%tail,['%store,['tableValue,cacheName,g1],['%pair,1,computeValue]]] - ['%store,['tableValue,cacheName,g1],computeValue] - if cacheNameOrNil then putCode := + ['CDDAR,['%store,['tableValue,cacheName,MKQ op], + ['%list,['%pair,'%nil,['%pair,1,computeValue]]]]] + computeValue + putCode := ['UNWIND_-PROTECT,['PROG1,putCode,['%store,g2,'%true]], ['%when,[['%not,g2],['tableRemove!,cacheName,MKQ op]]]] thirdPredPair:= ['%otherwise,putCode] @@ -244,20 +144,6 @@ compHash(op,argl,body,cacheNameOrNil,eqEtc,countFl) == sayBrightlyI bright '"Generated LISP code for function:" pp computeFunction compQuietly [computeFunction] - - if cacheNameOrNil = nil then - cacheType:= - countFl => 'hash_-tableWithCounts - 'hash_-table - weakStrong:= (countFl => 'STRONG; 'WEAK) - --note: WEAK means that key/value pairs disappear at garbage collection - cacheResetCode:= - ['SETQ,cacheName,['hashTable,MKQ eqEtc]] - cacheCountCode:= ['hashCount,cacheName] - cacheVector:= - mkCacheVec(op,cacheName,cacheType,cacheResetCode,cacheCountCode) - LAM_,EVALANDFILEACTQ ['PUT, MKQ op, MKQ 'cacheInfo, MKQ cacheVector] - LAM_,EVALANDFILEACTQ cacheResetCode op CDRwithIncrement x == diff --git a/src/interp/define.boot b/src/interp/define.boot index 25ab7aea..fa24ec4a 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -2097,7 +2097,7 @@ compileConstructor1(db,form:=[fn,[key,vl,:bodyl]]) == first compAndDefine [[fn,['SPADSLAM,vl,:bodyl]]] dbInstanceCache db = nil => first backendCompile [[fn,['LAMBDA,vl,:bodyl]]] - compClam(fn,vl,bodyl,[[fn,"$ConstructorCache",'domainEqualList,'count]]) + compHash(fn,vl,bodyl) constructMacro: %Form -> %Form constructMacro (form is [nam,[lam,vl,body]]) == diff --git a/src/interp/sys-globals.boot b/src/interp/sys-globals.boot index 5304caea..f611e829 100644 --- a/src/interp/sys-globals.boot +++ b/src/interp/sys-globals.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2011, Gabriel Dos Reis. +-- Copyright (C) 2007-2012, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -60,18 +60,6 @@ $BreakMode := "query" $cacheAlist := nil $cacheCount := 0 - -++ -$clamList := - '((canCoerce hash UEQUAL count) _ - (canCoerceFrom hash UEQUAL count) _ - (coerceConvertMmSelection hash UEQUAL count) _ - (isLegitimateMode hash UEQUAL count) _ - (isValidType hash UEQUAL count) _ - (resolveTT hash UEQUAL count) _ - (selectMms1 hash UEQUAL count) _ - (underDomainOf hash UEQUAL count)) - ++ $compCount := 0 diff --git a/src/share/doc/msgs/s2-us.msgs b/src/share/doc/msgs/s2-us.msgs index a9f281bd..c5e1ef48 100644 --- a/src/share/doc/msgs/s2-us.msgs +++ b/src/share/doc/msgs/s2-us.msgs @@ -1066,32 +1066,6 @@ S2GE0002 S2GE0003 The cache for %1b cannot be cleared because that function is not privately clammed. -S2GE0004 - The structure for the clammed function %1b - on $clammedList is not correct. It must have three entries after the - function name. -S2GE0005 - Illegal cache count for %1b -S2GE0006 - Illegal options for CLAMming function %1b: %2 %3 %4 -S2GE0007 - EQ cannot be used to CLAM a function with more than 1 argument and you - are trying to that for %1b -S2GE0008 - The shift option not meaningful for hash type of cache and you - are trying to that for %1b -S2GE0009 - Circular CLAMing illegal for 0-argument functions and you - are trying to that for %1b -S2GE0010 - Private CLAMing illegal for 0-argument functions and you - are trying to that for %1b -S2GE0011 - $ConstructorCache is only global cache now allowed and you are trying - to do otherwise for %1b -S2GE0012 - For hash option, only EQ, CVEC, and UEQUAL are allowed and you are - trying to do otherwise for %1b S2GE0013 %1b has the wrong format: the reference counts are missing. S2GE0014 |