aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog11
-rw-r--r--src/interp/c-util.boot10
-rw-r--r--src/interp/clam.boot160
-rw-r--r--src/interp/define.boot2
-rw-r--r--src/interp/sys-globals.boot14
-rw-r--r--src/share/doc/msgs/s2-us.msgs26
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-29 18:30:19 +0000