[squeak-dev] The Trunk: System-ul.1332.mczcommits at source.squeak.org commits at source.squeak.orgThu Mar 31 15:09:12 UTC 2022
Levente Uzonyi uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-ul.1332.mcz ==================== Summary ==================== Name: System-ul.1332 Author: ul Time: 31 March 2022, 5:09:06.559954 pm UUID: 681b55d7-1b75-4a3e-b571-f29ceaccaad2 Ancestors: System-mt.1331 - use Symbol class >> #lookup: instead of #hasInterned:ifTrue: =============== Diff against System-mt.1331 =============== Item was changed: ----- Method: DiskProxy>>comeFullyUpOnReload: (in category 'i/o') ----- comeFullyUpOnReload: smartRefStream "Internalize myself into a fully alive object after raw loading from a DataStream. (See my class comment.) DataStream will substitute the object from this eval for the DiskProxy." | globalObj symbol pr nn arrayIndex env | symbol := globalObjectName. "See if class is mapped to another name" (smartRefStream respondsTo: #renamed) ifTrue: [| maybeReadDataFromContext maybeReadArrayContext | "Ugh; so ugly and brittle. If there were pragmas in the relevant methods we could search, etc. eem 7/3/2017 15:54" maybeReadArrayContext := thisContext sender sender sender sender. maybeReadDataFromContext := maybeReadArrayContext sender sender sender sender. "If in outPointers in an ImageSegment, remember original class name. See mapClass:installIn:. Would be lost otherwise." "Anyone know where mapClass:installIn: is/was? eem 7/3/2017 15:55" (maybeReadDataFromContext method selector == #readDataFrom:size: and: [maybeReadDataFromContext receiver class == NativeImageSegment and: [maybeReadArrayContext method == (DataStream compiledMethodAt: #readArray)]]) ifTrue: [arrayIndex := maybeReadArrayContext tempAt: 4. "index var in readArray. Later safer to find i on stack of context." smartRefStream renamedConv at: arrayIndex put: symbol]. "save original name" symbol := smartRefStream renamed at: symbol ifAbsent: [symbol]]. "map" env := Environment current. globalObj := env valueOf: symbol ifAbsent: [ preSelector == nil & (constructorSelector = #yourself) ifTrue: [ Transcript cr; show: symbol, ' is undeclared.'. env undeclare: symbol. ^ nil]. ^ self error: 'Global "', symbol, '" not found']. ((symbol == #World) and: [Smalltalk isMorphic not]) ifTrue: [ self inform: 'These objects will work better if opened in a Morphic World. Dismiss and reopen all menus.']. preSelector ifNotNil: [ + (Symbol lookup: preSelector) ifNotNil: [:selector | - Symbol hasInterned: preSelector ifTrue: [:selector | [globalObj := globalObj perform: selector] on: Error do: [:ex | ex messageText = 'key not found' ifTrue: [^ nil]. ^ ex signal]] ]. symbol == #Project ifTrue: [ (constructorSelector = #fromUrl:) ifTrue: [ nn := (constructorArgs first findTokens: '/') last. nn := (nn findTokens: '.|') first. pr := Project named: nn. ^ pr ifNil: [self] ifNotNil: [pr]]. pr := globalObj perform: constructorSelector withArguments: constructorArgs. ^ pr ifNil: [self] ifNotNil: [pr]]. "keep the Proxy if Project does not exist" constructorSelector ifNil: [^ globalObj]. + (Symbol lookup: constructorSelector) ifNotNil: [:selector | - Symbol hasInterned: constructorSelector ifTrue: [:selector | [^ globalObj perform: selector withArguments: constructorArgs] on: Error do: [:ex | ex messageText = 'key not found' ifTrue: [^ nil]. ^ ex signal] ]. "args not checked against Renamed" ^ nil "was not in proper form"! Item was changed: ----- Method: ImageSegment>>comeFullyUpOnReload: (in category 'fileIn') ----- comeFullyUpOnReload: smartRefStream "fix up the objects in the segment that changed size. An object in the segment is the wrong size for the modern version of the class. Construct a fake class that is the old size. Replace the modern class with the old one in outPointers. Load the segment. Traverse the instances, making new instances by copying fields, and running conversion messages. Keep the new instances. Bulk forward become the old to the new. Let go of the fake objects and classes. After the install (below), arrayOfRoots is filled in. Globalize new classes. Caller may want to do some special install on certain objects in arrayOfRoots. May want to write the segment out to disk in its new form." | mapFakeClassesToReal receiverClasses existing forgetDoItsClass endianness | forgetDoItsClass := Set new. RecentlyRenamedClasses := nil. "in case old data hanging around" mapFakeClassesToReal := smartRefStream reshapedClassesIn: outPointers. "Dictionary of just the ones that change shape. Substitute them in outPointers." self fixCapitalizationOfSymbols. endianness := self endianness. segment := self loadSegmentFrom: segment outPointers: outPointers. arrayOfRoots := segment first. mapFakeClassesToReal isEmpty ifFalse: [ self reshapeClasses: mapFakeClassesToReal refStream: smartRefStream ]. "When a Project is stored, arrayOfRoots has all objects in the project, except those in outPointers" arrayOfRoots do: [:importedObject | ((importedObject isMemberOf: WideString) or: [importedObject isMemberOf: WideSymbol]) ifTrue: [ importedObject mutateJISX0208StringToUnicode. importedObject class = WideSymbol ifTrue: [ "self halt." + (Symbol lookup: importedObject) ifNotNil: [:multiSymbol | - Symbol hasInterned: importedObject asString ifTrue: [:multiSymbol | multiSymbol == importedObject ifFalse: [ importedObject becomeForward: multiSymbol. ]. ]. ]. ]. (importedObject isMemberOf: TTCFontSet) ifTrue: [ existing := TTCFontSet familyName: importedObject familyName pointSize: importedObject pointSize. "supplies default" existing == importedObject ifFalse: [importedObject becomeForward: existing]. ]. ]. receiverClasses := self restoreEndianness: endianness ~~ Smalltalk endianness. "rehash sets" smartRefStream checkFatalReshape: receiverClasses. "Classes in this segment." arrayOfRoots do: [:importedObject | importedObject class class == Metaclass ifTrue: [forgetDoItsClass add: importedObject. self declare: importedObject]]. "Let all extensions work with the current arrayOfRoots." self processRoots. mapFakeClassesToReal isEmpty ifFalse: [ mapFakeClassesToReal keysAndValuesDo: [:aFake :aReal | aFake removeFromSystemUnlogged. aFake becomeForward: aReal]. SystemOrganization removeEmptyCategories]. forgetDoItsClass do: [:c | self forgetDoItsInClass: c]. "^ self" ! Item was changed: ----- Method: SmartRefStream>>mapClass: (in category 'read write') ----- mapClass: incoming "See if the old class named nm exists. If so, return it. If not, map it to a new class, and save the mapping in renamed. " <hasLiteralTest: #isConversionSelector:> "To find this method as sender of all conversion methods" | cls oldVer sel nm | self flag: #bobconv. nm := renamed at: incoming ifAbsent: [incoming]. "allow pre-mapping around collisions" (nm endsWith: ' class') ifFalse: [cls := Smalltalk at: nm ifAbsent: [nil]. cls ifNotNil: [^ cls]] "Known class. It will know how to translate the instance." ifTrue: [cls := Smalltalk at: nm substrings first asSymbol ifAbsent: [nil]. cls ifNotNil: [^ cls class]]. "Known class. It will know how to translate the instance." oldVer := self versionSymbol: (structures at: nm). sel := nm asString. sel at: 1 put: (sel at: 1) asLowercase. sel := sel, oldVer. "i.e. #rectangleoc4" + (Symbol lookup: sel) ifNotNil: [:symb | - Symbol hasInterned: sel ifTrue: [:symb | (self class canUnderstand: sel asSymbol) ifTrue: [ reshaped ifNil: [reshaped := Dictionary new]. cls := self perform: sel asSymbol]]. "This class will take responsibility" cls ifNil: [cls := self writeClassRenameMethod: sel was: nm fromInstVars: (structures at: nm). cls isString ifTrue: [cls := nil]]. cls ifNotNil: [renamed at: nm put: cls name]. ^ cls ! Item was changed: ----- Method: SystemDictionary>>hasClassNamed: (in category 'classes and traits') ----- hasClassNamed: aString "Answer whether there is a class of the given name, but don't intern aString if it's not alrady interned. 4/29/96 sw" + ^(Symbol lookup: aString) + ifNil: [ false ] + ifNotNil: [ :aSymbol | (self at: aSymbol ifAbsent: [nil]) isKindOf: Class ]! - Symbol hasInterned: aString ifTrue: - [:aSymbol | ^ (self at: aSymbol ifAbsent: [nil]) isKindOf: Class]. - ^ false!
More information about the Squeak-dev mailing list |