diff -r a27a279701f8 -r 6526dde5f3ac Class.st --- a/Class.st Fri Jul 16 11:39:45 1993 +0200 +++ b/Class.st Mon Oct 04 11:32:33 1993 +0100 @@ -11,7 +11,7 @@ " ClassDescription subclass:#Class - instanceVariableNames:'classvars comment subclasses' + instanceVariableNames:'classvars comment subclasses classFileName' classVariableNames:'updatingChanges' poolDictionaries:'' category:'Kernel-Classes' @@ -36,6 +36,8 @@ comment the classes comment subclasses cached collection of subclasses (currently unused - but will be soon) +classFileName the file (or nil) where the classes + sources are found Class variables: @@ -73,6 +75,13 @@ !Class methodsFor:'autoload check'! +isLoaded + "return true, if the class has been loaded; redefined in Autoload; + see comment there" + + ^ true +! + autoload "force autoloading - do nothing here; redefined in Autoload; see comment there" @@ -105,14 +114,6 @@ comment:nil changed:false ]. - self isPointers ifTrue:[ - ^ self - variableSubclass:t - instanceVariableNames:f - classVariableNames:d - poolDictionaries:s - category:cat - ]. self isBytes ifTrue:[ ^ self variableByteSubclass:t @@ -145,9 +146,16 @@ poolDictionaries:s category:cat ]. - "only word is left over" + self isWords ifTrue:[ + ^ self + variableWordSubclass:t + instanceVariableNames:f + classVariableNames:d + poolDictionaries:s + category:cat + ]. ^ self - variableWordSubclass:t + variableSubclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s @@ -659,6 +667,20 @@ ] ! +addChangeRecordForClassInstvars:aClass + "add a class-instvars-record to the changes file" + + |aStream| + + aStream := self changesStream. + aStream notNil ifTrue:[ + aClass fileOutClassInstVarDefinitionOn:aStream. + aStream nextPut:$!!. + aStream cr. + aStream close + ] +! + addChangeRecordForClassComment:aClass "add a class-comment-record to the changes file" @@ -705,16 +727,37 @@ (Smalltalk at:#Compiler) compile:code forClass:self notifying:requestor ! +recompileMethodsAccessingAny:setOfNames + "recompile all methods accessing a variable from setOfNames" + + |p| + + self selectors do:[:aSelector | + |m| + + m := self compiledMethodAt:aSelector. + p := Parser parseMethod:(m source) in:self. + (p isNil or:[p usedVars notNil and:[p usedVars includesAny:setOfNames]]) ifTrue:[ + self recompile:aSelector + ] + ] +! + recompile:aSelector "recompile the method associated with the argument, aSelector; used when a superclass changes instances and we have to recompile subclasses" - |cat code| + |cat code upd| - cat := (self compiledMethodAt:aSelector) category. - code := self sourceCodeAt:aSelector. - (Smalltalk at:#Compiler) compile:code forClass:self inCategory:cat + upd := Class updateChanges:false. + [ + cat := (self compiledMethodAt:aSelector) category. + code := self sourceCodeAt:aSelector. + (Smalltalk at:#Compiler) compile:code forClass:self inCategory:cat + ] valueNowOrOnUnwindDo:[ + Class updateChanges:upd + ] ! recompile @@ -730,97 +773,42 @@ recompileAll "recompile this class and all subclasses" - |subclasses| + |classes| + + classes := self subclasses. + self recompile. + classes do:[:aClass | + aClass recompileAll + ] +! + +recompileInvalidatedMethods + "recompile all invalidated methods" - subclasses := self subclasses. - self recompile. - subclasses do:[:aClass | - aClass recompileAll + |trap trapCode trapByteCode| + + trap := Method compiledMethodAt:#invalidMethod. + trapCode := trap code. + trapByteCode := trap byteCode. + + self selectors do:[:aSelector | + |m| + + m := self compiledMethodAt:aSelector. + ((m code == trapCode) and:[m byteCode == trapByteCode]) ifTrue:[ + self recompile:aSelector + ] ] ! ! !Class methodsFor:'queries'! -selectorIndex:aSelector - "return the index in the arrays for given selector aSelector" - - ^ selectors identityIndexOf:aSelector startingAt:1 -! - -compiledMethodAt:aSelector - "return the method for given selector aSelector" - - |index| - - index := selectors identityIndexOf:aSelector startingAt:1. - (index == 0) ifTrue:[^ nil]. - ^ methods at:index -! - -sourceCodeAt:aSelector - "return the methods source for given selector aSelector" - - |index| - - index := selectors identityIndexOf:aSelector startingAt:1. - (index == 0) ifTrue:[^ nil]. - ^ (methods at:index) source -! - -hasMethods - "return true, if there are any (local) methods in this class" - - methods isNil ifTrue:[^ false]. - ^ (methods size ~~ 0) -! - -implements:aSelector - "Return true, if I implement selector" - - ^ (selectors identityIndexOf:aSelector startingAt:1) ~~ 0 -! +isClass + "return true, if the receiver is some kind of class (real class, not + just behavior); + true is returned here - the method is redefined from Object" -canUnderstand:aSelector - "Return true, if I or one of my superclasses implements selector" - - |classToLookAt| - - classToLookAt := self. - [classToLookAt notNil] whileTrue:[ - (classToLookAt implements:aSelector) ifTrue:[^ true]. - classToLookAt := classToLookAt superclass - ]. - ^ false -! - -whichClassImplements:aSelector - "Return the class (the receiver or a class in the superclass-chain) - which implements given selector aSelector, if none, return nil" - - |classToLookAt| - - classToLookAt := self. - [classToLookAt notNil] whileTrue:[ - (classToLookAt implements:aSelector) ifTrue:[^ classToLookAt]. - classToLookAt := classToLookAt superclass - ]. - ^ nil -! - -selectorForMethod:aMethod - "Return the selector for given method aMethod" - - |index| - - index := methods identityIndexOf:aMethod startingAt:1. - (index == 0) ifTrue:[^ nil]. - ^ selectors at:index -! - -containsMethod:aMethod - "Return true, if aMethod is a method of myself" - - ^ (methods identityIndexOf:aMethod startingAt:1) ~~ 0 + ^ true ! categories @@ -1118,22 +1106,22 @@ isVar := (self isVariable and:[superclass isVariable not]) ]. isVar ifTrue:[ - self isPointers ifTrue:[ - line := line , ' variableSubclass:#' + self isBytes ifTrue:[ + line := line , ' variableByteSubclass:#' ] ifFalse:[ - self isBytes ifTrue:[ - line := line , ' variableByteSubclass:#' + self isWords ifTrue:[ + line := line , ' variableWordSubclass:#' ] ifFalse:[ - self isWords ifTrue:[ - line := line , ' variableWordSubclass:#' + self isLongs ifTrue:[ + line := line , ' variableLongSubclass:#' ] ifFalse:[ - self isLongs ifTrue:[ - line := line , ' variableLongSubclass:#' + self isFloats ifTrue:[ + line := line , ' variableFloatSubclass:#' ] ifFalse:[ - self isFloats ifTrue:[ - line := line , ' variableFloatSubclass:#' + self isDoubles ifTrue:[ + line := line , ' variableDoubleSubclass:#' ] ifFalse:[ - line := line , ' variableDoubleSubclass:#' + line := line , ' variableSubclass:#' ] ] ] @@ -1649,3 +1637,23 @@ ] ] ! ! + +!Class methodsFor: 'binary storage'! + +addGlobalsTo: globalDictionary manager: manager +" + classPool == nil ifFalse: [ + classPool associationsDo: [:assoc| + globalDictionary at: assoc put: self + ] + ] +" +! + +storeBinaryDefinitionOf: anAssociation on: stream manager: manager + | string | + + string := self name, ' classPool at: ', anAssociation key storeString. + stream nextNumber: 2 put: string size. + string do: [:char| stream nextPut: char asciiValue] +! !