Squeak-dev January 2013

squeak-dev@lists.squeakfoundation.org

105 participants
332 discussions

The Trunk: Collections-nice.497.mcz
by commits＠source.squeak.org 02 Jan '13

02 Jan '13

Nicolas Cellier uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-nice.497.mcz ==================== Summary ==================== Name: Collections-nice.497 Author: nice Time: 2 January 2013, 6:36:54.091 pm UUID: 98612202-e775-d64b-a663-1a2a9909d92c Ancestors: Collections-bf.496 Thu shalt not invoke super in vain =============== Diff against Collections-bf.496 =============== Item was changed: ----- Method: CharacterSetComplement class>>of: (in category 'instance creation') ----- of: aCharacterSet "answer the complement of aCharacterSet" + ^ self new complement: aCharacterSet! - ^ super new complement: aCharacterSet!

1 0

Re: [squeak-dev] The Trunk: Compiler-cwp.245.mcz
by Chris Muller 02 Jan '13

02 Jan '13

Ha, you've just been bustin' at the seams to release this haven't you? :) On Tue, Jan 1, 2013 at 5:48 PM, <commits(a)source.squeak.org> wrote: > Colin Putney uploaded a new version of Compiler to project The Trunk: > http://source.squeak.org/trunk/Compiler-cwp.245.mcz > > ==================== Summary ==================== > > Name: Compiler-cwp.245 > Author: cwp > Time: 1 January 2013, 6:47:22.812 pm > UUID: ded24bcc-aeee-4129-94fa-2b2da294e964 > Ancestors: Compiler-eem.243 > > Environments bootstrap - stage 1 > > =============== Diff against Compiler-eem.243 =============== > > Item was added: > + Object subclass: #CompilationCue > + instanceVariableNames: 'source context receiver class environment category requestor' > + classVariableNames: '' > + poolDictionaries: '' > + category: 'Compiler-Kernel'! > > Item was added: > + ----- Method: CompilationCue class>>class: (in category 'instance creation') ----- > + class: aClass > + ^ self > + context: nil > + class: aClass > + requestor: nil! > > Item was added: > + ----- Method: CompilationCue class>>context:class:requestor: (in category 'instance creation') ----- > + context: aContext class: aClass requestor: anObject > + ^ self > + source: nil > + context: aContext > + receiver: nil > + class: aClass > + environment: (aClass ifNotNil: [aClass environment]) > + category: nil > + requestor: anObject! > > Item was added: > + ----- Method: CompilationCue class>>source:class:environment:category:requestor: (in category 'instance creation') ----- > + source: aTextOrStream class: aClass environment: anEnvironment category: aString requestor: anObject > + ^ self > + source: aTextOrStream > + context: nil > + receiver: nil > + class: aClass > + environment: anEnvironment > + category: aString > + requestor: anObject! > > Item was added: > + ----- Method: CompilationCue class>>source:context:class:category:requestor: (in category 'instance creation') ----- > + source: aTextOrStream context: aContext class: aClass category: aString requestor: anObject > + ^ self > + source: aTextOrStream > + context: aContext > + receiver: (aContext ifNotNil: [aContext receiver]) > + class: aClass > + environment: (aClass ifNotNil: [aClass environment]) > + category: aString > + requestor: anObject! > > Item was added: > + ----- Method: CompilationCue class>>source:context:class:requestor: (in category 'instance creation') ----- > + source: aTextOrStream context: aContext class: aClass requestor: anObject > + ^ self > + source: aTextOrStream > + context: aContext > + class: aClass > + category: nil > + requestor: anObject! > > Item was added: > + ----- Method: CompilationCue class>>source:context:receiver:class:environment:category:requestor: (in category 'instance creation') ----- > + source: aTextOrStream context: aContext receiver: recObject class: aClass environment: anEnvironment category: aString requestor: reqObject > + ^ self basicNew > + initializeWithSource: aTextOrStream > + context: aContext > + receiver: recObject > + class: aClass > + environment: anEnvironment > + category: aString > + requestor: reqObject! > > Item was added: > + ----- Method: CompilationCue class>>source:environment: (in category 'instance creation') ----- > + source: aString environment: anEnvironment > + ^ self > + source: aString > + context: nil > + receiver: nil > + class: UndefinedObject > + environment: anEnvironment > + category: nil > + requestor: nil! > > Item was added: > + ----- Method: CompilationCue class>>source:requestor: (in category 'instance creation') ----- > + source: aTextOrStream requestor: anObject > + ^ self > + source: aTextOrStream > + context: nil > + class: nil > + requestor: anObject! > > Item was added: > + ----- Method: CompilationCue>>bindingOf: (in category 'binding') ----- > + bindingOf: aSymbol > + ^ class bindingOf: aSymbol environment: environment! > > Item was added: > + ----- Method: CompilationCue>>category (in category 'accessing') ----- > + category > + ^ category! > > Item was added: > + ----- Method: CompilationCue>>context (in category 'accessing') ----- > + context > + ^ context! > > Item was added: > + ----- Method: CompilationCue>>environment (in category 'accessing') ----- > + environment > + ^ environment! > > Item was added: > + ----- Method: CompilationCue>>getClass (in category 'accessing') ----- > + getClass > + ^ class! > > Item was added: > + ----- Method: CompilationCue>>initializeWithSource:context:receiver:class:environment:category:requestor: (in category 'initialization') ----- > + initializeWithSource: aTextOrString context: aContext receiver: recObject class: aClass environment: anEnvironment category: aString requestor: reqObject > + self initialize. > + source := aTextOrString isStream ifTrue: [aTextOrString contents] ifFalse: [aTextOrString]. > + context := aContext. > + receiver := recObject. > + class := aClass. > + environment := anEnvironment. > + category := aString. > + requestor := reqObject! > > Item was added: > + ----- Method: CompilationCue>>literalScannedAs:notifying: (in category 'binding') ----- > + literalScannedAs: anObject notifying: anEncoder > + ^ class literalScannedAs: anObject environment: environment notifying: anEncoder! > > Item was added: > + ----- Method: CompilationCue>>receiver (in category 'accessing') ----- > + receiver > + ^ receiver! > > Item was added: > + ----- Method: CompilationCue>>requestor (in category 'accessing') ----- > + requestor > + ^ requestor! > > Item was added: > + ----- Method: CompilationCue>>source (in category 'accessing') ----- > + source > + ^ source! > > Item was added: > + ----- Method: CompilationCue>>sourceStream (in category 'accessing') ----- > + sourceStream > + ^ source readStream! > > Item was changed: > Object subclass: #Compiler > + instanceVariableNames: 'sourceStream requestor class category context parser cue' > - instanceVariableNames: 'sourceStream requestor class category context parser' > classVariableNames: '' > poolDictionaries: '' > category: 'Compiler-Kernel'! > > + !Compiler commentStamp: 'cwp 12/26/2012 23:17' prior: 0! > - !Compiler commentStamp: '<historical>' prior: 0! > The compiler accepts Smalltalk source code and compiles it with respect to a given class. The user of the compiler supplies a context so that temporary variables are accessible during compilation. If there is an error, a requestor (usually a kind of StringHolderController) is sent the message notify:at:in: so that the error message can be displayed. If there is no error, then the result of compilation is a MethodNode, which is the root of a parse tree whose nodes are kinds of ParseNodes. The parse tree can be sent messages to (1) generate code for a CompiledMethod (this is done for compiling methods or evaluating expressions); (2) pretty-print the code (for formatting); or (3) produce a map from object code back to source code (used by debugger program-counter selection). See also Parser, Encoder, ParseNode.! > > Item was added: > + ----- Method: Compiler class>>evaluate:environment: (in category 'evaluating') ----- > + evaluate: aString environment: anEnvironment > + ^ self > + evaluate: aString > + environment: anEnvironment > + logged: false! > > Item was added: > + ----- Method: Compiler class>>evaluate:environment:logged: (in category 'evaluating') ----- > + evaluate: aString environment: anEnvironment logged: aBoolean > + | cue | > + cue := CompilationCue > + source: aString > + environment: anEnvironment. > + > + ^ self new > + evaluate: aString > + cue: cue > + ifFail: [^ nil] > + logged: aBoolean! > > Item was added: > + ----- Method: Compiler>>compile:ifFail: (in category 'public access') ----- > + compile: aCue ifFail: failBlock > + "Answer a MethodNode. If the MethodNode can not be created, notify > + the requestor in the contxt. If the requestor is nil, evaluate failBlock > + instead. The MethodNode is the root of a parse tree. It can be told > + to generate a CompiledMethod to be installed in the method dictionary > + of the class specified by the context." > + > + self setCue: aCue. > + self source: cue source. > + ^self > + translate: sourceStream > + noPattern: false > + ifFail: failBlock! > > Item was added: > + ----- Method: Compiler>>evaluate:cue:ifFail:logged: (in category 'public access') ----- > + evaluate: textOrStream cue: aCue ifFail: failBlock logged: logFlag > + "Compiles the sourceStream into a parse tree, then generates code into > + a method. Finally, the compiled method is invoked from here via withArgs:executeMethod:, hence the system no longer creates Doit method > + litter on errors." > + > + | methodNode method value toLog itsSelection itsSelectionString | > + self setCue: aCue. > + self source: textOrStream. > + methodNode := self translate: sourceStream noPattern: true ifFail: [^failBlock value]. > + > + method := self interactive > + ifTrue: [methodNode generateWithTempNames] > + ifFalse: [methodNode generate]. > + > + value := cue receiver > + withArgs: (cue context ifNil: [#()] ifNotNil: [{cue context}]) > + executeMethod: method. > + > + logFlag ifTrue: > + [toLog := ((cue requestor respondsTo: #selection) > + and:[(itsSelection := cue requestor selection) notNil > + and:[(itsSelectionString := itsSelection asString) isEmptyOrNil not]]) > + ifTrue:[itsSelectionString] > + ifFalse:[sourceStream contents]. > + SystemChangeNotifier uniqueInstance evaluated: toLog context: cue context]. > + ^ value > + ! > > Item was added: > + ----- Method: Compiler>>setCue: (in category 'private') ----- > + setCue: aCue > + cue := aCue. > + > + "Set legacy instance variables for methods that don't use cue yet." > + requestor := cue requestor. > + class := cue getClass. > + category := cue category. > + context := cue context.! > > Item was added: > + ----- Method: Compiler>>source: (in category 'private') ----- > + source: textOrStream > + sourceStream := (textOrStream isKindOf: PositionableStream) > + ifTrue: [ textOrStream ] > + ifFalse: [ ReadStream on: textOrStream asString ]! > > Item was added: > + ----- Method: Dictionary>>bindingOf:ifAbsent: (in category '*Compiler') ----- > + bindingOf: varName ifAbsent: aBlock > + > + ^self associationAt: varName ifAbsent: aBlock! > > Item was changed: > ParseNode subclass: #Encoder > + instanceVariableNames: 'scopeTable nTemps supered requestor class selector literalStream selectorSet litIndSet litSet sourceRanges globalSourceRanges addedSelectorAndMethodClassLiterals optimizedSelectors cue' > - instanceVariableNames: 'scopeTable nTemps supered requestor class selector literalStream selectorSet litIndSet litSet sourceRanges globalSourceRanges addedSelectorAndMethodClassLiterals optimizedSelectors' > classVariableNames: '' > poolDictionaries: '' > category: 'Compiler-Kernel'! > > + !Encoder commentStamp: 'cwp 12/26/2012 23:29' prior: 0! > - !Encoder commentStamp: '<historical>' prior: 0! > I encode names and literals into tree nodes with byte codes for the compiler. Byte codes for literals are not assigned until the tree-sizing pass of the compiler, because only then is it known which literals are actually needed. I also keep track of sourceCode ranges during parsing and code generation so I can provide an inverse map for the debugger.! > > Item was added: > + ----- Method: Encoder>>init:notifying: (in category 'initialize-release') ----- > + init: aCue notifying: anObject > + "The use of the variable requestor is a bit confusing here. This is > + *not* the original requestor, which is available through the cue. > + It's the Parser instance that is using the encoder." > + > + self setCue: aCue. > + requestor := anObject. > + nTemps := 0. > + supered := false. > + self initScopeAndLiteralTables. > + cue getClass variablesAndOffsetsDo: > + [:variable "<String|CFieldDefinition>" :offset "<Integer|nil>" | > + offset isNil > + ifTrue: [scopeTable at: variable name put: (FieldNode new fieldDefinition: variable)] > + ifFalse: [scopeTable > + at: variable > + put: (offset >= 0 > + ifTrue: [InstanceVariableNode new > + name: variable index: offset] > + ifFalse: [MaybeContextInstanceVariableNode new > + name: variable index: offset negated])]]. > + cue context ~~ nil ifTrue: > + [| homeNode | > + homeNode := self bindTemp: self doItInContextName. > + "0th temp = aContext passed as arg" > + cue context tempNames withIndexDo: > + [:variable :index| > + scopeTable > + at: variable > + put: (MessageAsTempNode new > + receiver: homeNode > + selector: #namedTempAt: > + arguments: (Array with: (self encodeLiteral: index)) > + precedence: 3 > + from: self)]]. > + sourceRanges := Dictionary new: 32. > + globalSourceRanges := OrderedCollection new: 32 > + ! > > Item was added: > + ----- Method: Encoder>>setCue: (in category 'private') ----- > + setCue: aCue > + cue := aCue. > + > + "Also set legacy instance variables for methods that > + don't use cue yet" > + class := cue getClass.! > > Item was changed: > Scanner subclass: #Parser > + instanceVariableNames: 'here hereType hereMark hereEnd prevMark prevEnd encoder requestor parseNode failBlock requestorOffset tempsMark doitFlag properties category queriedUnusedTemporaries cue' > - instanceVariableNames: 'here hereType hereMark hereEnd prevMark prevEnd encoder requestor parseNode failBlock requestorOffset tempsMark doitFlag properties category queriedUnusedTemporaries' > classVariableNames: '' > poolDictionaries: '' > category: 'Compiler-Kernel'! > > + !Parser commentStamp: 'cwp 12/26/2012 23:34' prior: 0! > - !Parser commentStamp: '<historical>' prior: 0! > I parse Smalltalk syntax and create a MethodNode that is the root of the parse tree. I look one token ahead.! > > Item was added: > + ----- Method: Parser>>init:cue:failBlock: (in category 'private') ----- > + init: sourceStream cue: aCue failBlock: aBlock > + > + self setCue: aCue. > + failBlock := aBlock. > + requestorOffset := 0. > + super scan: sourceStream. > + prevMark := hereMark := mark. > + self advance > + ! > > Item was added: > + ----- Method: Parser>>parse:cue:noPattern:ifFail: (in category 'public access') ----- > + parse: sourceStream cue: aCue noPattern: noPattern ifFail: aBlock > + "Answer a MethodNode for the argument, sourceStream, that is the root of > + a parse tree. Parsing is done with respect to the CompilationCue to > + resolve variables. Errors in parsing are reported to the cue's requestor; > + otherwise aBlock is evaluated. The argument noPattern is a Boolean that is > + true if the the sourceStream does not contain a method header (i.e., for DoIts)." > + > + | methNode repeatNeeded myStream s p subSelection | > + myStream := sourceStream. > + [repeatNeeded := false. > + p := myStream position. > + s := myStream upToEnd. > + myStream position: p. > + subSelection := aCue requestor notNil and: [aCue requestor selectionInterval = (p + 1 to: p + s size)]. > + self encoder init: aCue notifying: self. > + self init: myStream cue: aCue failBlock: [^ aBlock value]. > + doitFlag := noPattern. > + failBlock:= aBlock. > + [methNode := self method: noPattern context: cue context] > + on: ReparseAfterSourceEditing > + do: [ :ex | > + repeatNeeded := true. > + myStream := subSelection > + ifTrue: > + [ReadStream > + on: cue requestor text string > + from: cue requestor selectionInterval first > + to: cue requestor selectionInterval last] > + ifFalse: > + [ReadStream on: cue requestor text string]]. > + repeatNeeded] whileTrue: > + [encoder := self encoder class new]. > + methNode sourceText: s. > + ^methNode > + ! > > Item was added: > + ----- Method: Parser>>setCue: (in category 'private') ----- > + setCue: aCue > + cue := aCue. > + > + "Also set legacy variables for methods that don't use cue yet." > + requestor := cue requestor. > + category := cue category.! > >

1 0

The Trunk: Tests-fbs.180.mcz
by commits＠source.squeak.org 02 Jan '13

02 Jan '13

Frank Shearar uploaded a new version of Tests to project The Trunk: http://source.squeak.org/trunk/Tests-fbs.180.mcz ==================== Summary ==================== Name: Tests-fbs.180 Author: fbs Time: 2 January 2013, 11:53:05.464 am UUID: 92a01e46-c207-431d-9433-5dbd5c9fc712 Ancestors: Tests-fbs.179 This does _not_ fix the failing test. I'm renaming in a separate commit so that the actual fix is apparent (when someone does so). =============== Diff against Tests-fbs.179 =============== Item was added: + ----- Method: ClassRemovalTest>>testClassRemovalAndRecompilationWontCreateDuplicateVariableBindings (in category 'tests') ----- + testClassRemovalAndRecompilationWontCreateDuplicateVariableBindings + + self + assert: isClean + description: 'The system category or the classes about to be created already exist.'. + "Create a class" + Object subclass: self className1 + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: self systemCategoryName. + "Create another" + Object subclass: self className2 + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: self systemCategoryName. + "Compile a method in the second which references the first" + (Smalltalk at: self className2) + compile: 'foo ^', self className1 + classified: 'accessing'. + "Remove the first class" + (Smalltalk at: self className1) removeFromSystem. + "Compile the first class again" + Object subclass: self className1 + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: self systemCategoryName. + self + deny: (Smalltalk at: self className2) new foo isObsolete + description: '#foo refers to an obsolete class'. + self + assert: (Smalltalk at: self className1) == + (Smalltalk at: self className2) new foo + description: '#foo refers to a different class'! Item was removed: - ----- Method: ClassRemovalTest>>testClassRemovalAndRecompilcationWontCreateDuplicateVariableBindings (in category 'tests') ----- - testClassRemovalAndRecompilcationWontCreateDuplicateVariableBindings - - self - assert: isClean - description: 'The system category or the classes about to be created already exist.'. - "Create a class" - Object subclass: self className1 - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: self systemCategoryName. - "Create another" - Object subclass: self className2 - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: self systemCategoryName. - "Compile a method in the second which references the first" - (Smalltalk at: self className2) - compile: 'foo ^', self className1 - classified: 'accessing'. - "Remove the first class" - (Smalltalk at: self className1) removeFromSystem. - "Compile the first class again" - Object subclass: self className1 - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: self systemCategoryName. - self - deny: (Smalltalk at: self className2) new foo isObsolete - description: '#foo refers to an obsolete class'. - self - assert: (Smalltalk at: self className1) == - (Smalltalk at: self className2) new foo - description: '#foo refers to a different class'!

1 0

The Trunk: Tests-fbs.179.mcz
by commits＠source.squeak.org 02 Jan '13

02 Jan '13

Frank Shearar uploaded a new version of Tests to project The Trunk: http://source.squeak.org/trunk/Tests-fbs.179.mcz ==================== Summary ==================== Name: Tests-fbs.179 Author: fbs Time: 2 January 2013, 11:25:32.496 am UUID: bda17be6-c887-4d49-b0a6-91bdcad760f1 Ancestors: Tests-fbs.178 Update PackageDependencyTest to reflect the new relationships between Environments and other packages. =============== Diff against Tests-fbs.178 =============== Item was changed: ----- Method: PackageDependencyTest>>testKernel (in category 'tests') ----- testKernel self testPackage: 'Kernel' dependsExactlyOn: #( Collections Compiler Compression + Environments Exceptions Files Graphics MorphicExtras Multilingual System 'ToolBuilder-Kernel' Tools Traits ).! Item was changed: ----- Method: PackageDependencyTest>>testSystem (in category 'tests') ----- testSystem self testPackage: 'System' dependsExactlyOn: #( Collections Compiler Compression + Environments Exceptions Files GetText Graphics Kernel Monticello MonticelloConfigurations Morphic MorphicExtras Multilingual Network 'PackageInfo-Base' Protocols Sound 'ToolBuilder-Kernel' Tools TrueType ).!

1 0

Re: [squeak-dev] The Trunk: ReleaseBuilder-fbs.89.mcz
by Frank Shearar 02 Jan '13

02 Jan '13

On 31 December 2012 20:46, <commits(a)source.squeak.org> wrote: > Frank Shearar uploaded a new version of ReleaseBuilder to project The Trunk: > http://source.squeak.org/trunk/ReleaseBuilder-fbs.89.mcz > > ==================== Summary ==================== > > Name: ReleaseBuilder-fbs.89 > Author: fbs > Time: 31 December 2012, 8:46:19.365 pm > UUID: a99900e3-d3c9-4284-afb5-89c046ddc44d > Ancestors: ReleaseBuilder-fbs.88 > > Transferring packages to the new update stream requires valid credentials. This lets the release manager transfer things without changing source, and without storing credentials in the image. Consider this the first commit on the 4.5 stream! frank

2 3

The Trunk: Traits-cwp.292.mcz
by commits＠source.squeak.org 02 Jan '13

02 Jan '13

Colin Putney uploaded a new version of Traits to project The Trunk: http://source.squeak.org/trunk/Traits-cwp.292.mcz ==================== Summary ==================== Name: Traits-cwp.292 Author: cwp Time: 1 January 2013, 7:05:34.365 pm UUID: 046dee69-eb88-4abe-b6d8-f0de8dd035a5 Ancestors: Traits-ul.290 Environments bootstrap - stage 3 =============== Diff against Traits-ul.290 =============== Item was changed: ----- Method: Trait>>rename: (in category 'initialize') ----- rename: aString "The new name of the receiver is the argument, aString." | newName | (newName := aString asSymbol) ~= self name ifFalse: [^ self]. (self environment includesKey: newName) ifTrue: [^ self error: newName , ' already exists']. + (self environment undeclared includesKey: newName) - (Undeclared includesKey: newName) ifTrue: [self inform: 'There are references to, ' , aString printString , ' from Undeclared. Check them after this change.']. self environment renameClass: self as: newName. name := newName!

1 0

The Trunk: Tools-cwp.433.mcz
by commits＠source.squeak.org 02 Jan '13

02 Jan '13

Colin Putney uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-cwp.433.mcz ==================== Summary ==================== Name: Tools-cwp.433 Author: cwp Time: 1 January 2013, 7:04:22.314 pm UUID: 270fb729-cc8c-47d2-8eb3-7c39fdd965b9 Ancestors: Tools-eem.431 Environments bootstrap - stage 3 =============== Diff against Tools-eem.431 =============== Item was changed: CodeHolder subclass: #Browser + instanceVariableNames: 'environment systemOrganizer classOrganizer metaClassOrganizer editSelection metaClassIndicated selectedSystemCategory selectedClassName selectedMessageName selectedMessageCategoryName' - instanceVariableNames: 'systemOrganizer classOrganizer metaClassOrganizer editSelection metaClassIndicated selectedSystemCategory selectedClassName selectedMessageName selectedMessageCategoryName' classVariableNames: 'ListClassesHierarchically RecentClasses' poolDictionaries: '' category: 'Tools-Browser'! + !Browser commentStamp: 'cwp 12/27/2012 11:09' prior: 0! - !Browser commentStamp: '<historical>' prior: 0! I represent a query path into the class descriptions, the software of the system.! Item was added: + ----- Method: Browser>>selectEnvironment: (in category 'accessing') ----- + selectEnvironment: anEnvironment + environment := anEnvironment. + systemOrganizer := environment organization! Item was changed: ----- Method: Browser>>selectedEnvironment (in category 'system category list') ----- selectedEnvironment "Answer the name of the selected system category or nil." self hasSystemCategorySelected ifFalse: [^nil]. + ^ environment ifNil: [Smalltalk]! - ^ Smalltalk! Item was changed: ----- Method: Browser>>setClass:selector: (in category 'initialize-release') ----- setClass: aBehavior selector: aSymbol "Set the state of a new, uninitialized Browser." | isMeta aClass messageCatIndex | aBehavior ifNil: [^ self]. (aBehavior isKindOf: Metaclass) ifTrue: [ isMeta := true. aClass := aBehavior soleInstance] ifFalse: [ isMeta := false. aClass := aBehavior]. + self selectEnvironment: aClass environment. self selectCategoryForClass: aClass. self classListIndex: (self classListIndexOf: aClass name). self metaClassIndicated: isMeta. aSymbol ifNil: [^ self]. messageCatIndex := aBehavior organization numberOfCategoryOfElement: aSymbol. self messageCategoryListIndex: (messageCatIndex > 0 ifTrue: [messageCatIndex + 1] ifFalse: [0]). messageCatIndex = 0 ifTrue: [^ self]. self messageListIndex: ( (aBehavior organization listAtCategoryNumber: messageCatIndex) indexOf: aSymbol).!

1 0

The Trunk: System-cwp.508.mcz
by commits＠source.squeak.org 02 Jan '13

02 Jan '13

Colin Putney uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-cwp.508.mcz ==================== Summary ==================== Name: System-cwp.508 Author: cwp Time: 1 January 2013, 7:02:44.065 pm UUID: ba757102-dd85-4434-883b-f8f4f4e89285 Ancestors: System-cwp.507 Environments bootstrap - stage 3 =============== Diff against System-cwp.507 =============== Item was changed: ----- Method: InternalTranslator>>scanFrom: (in category 'fileIn/fileOut') ----- scanFrom: aStream + ^ self scanFrom: aStream environment: Environment default! - "Read a definition of dictionary. - Make sure current locale corresponds my locale id" - | aString newTranslations assoc currentPlatform | - newTranslations := Dictionary new. - currentPlatform := Locale currentPlatform. - [Locale - currentPlatform: (Locale localeID: id). - [aString := aStream nextChunk withSqueakLineEndings. - aString size > 0] - whileTrue: [assoc := Compiler evaluate: aString. - assoc value = '' - ifTrue: [self class registerPhrase: assoc key] - ifFalse: [newTranslations add: assoc]]] - ensure: [Locale currentPlatform: currentPlatform]. - self mergeTranslations: newTranslations! Item was changed: ----- Method: NaturalLanguageTranslator>>scanFrom: (in category 'fileIn/fileOut') ----- scanFrom: aStream + ^ self scanFrom: aStream environment: Environment default! - "Read a definition of dictionary. - Make sure current locale corresponds my locale id" - | newTranslations currentPlatform | - newTranslations := Dictionary new. - currentPlatform := Locale currentPlatform. - [ | aString assoc | - Locale - currentPlatform: (Locale localeID: id). - [aString := aStream nextChunk withSqueakLineEndings. - aString size > 0] - whileTrue: [assoc := Compiler evaluate: aString. - assoc value = '' - ifTrue: [self class registerPhrase: assoc key] - ifFalse: [newTranslations add: assoc]]] - ensure: [Locale currentPlatform: currentPlatform]. - self mergeTranslations: newTranslations! Item was changed: ----- Method: SmalltalkImage>>cleanOutUndeclared (in category 'housekeeping') ----- cleanOutUndeclared + globals undeclared removeUnreferencedKeys! - Undeclared removeUnreferencedKeys! Item was changed: ----- Method: SmalltalkImage>>recreateSpecialObjectsArray (in category 'special objects') ----- recreateSpecialObjectsArray "Smalltalk recreateSpecialObjectsArray" "To external package developers: **** DO NOT OVERRIDE THIS METHOD. ***** If you are writing a plugin and need additional special object(s) for your own use, use addGCRoot() function and use own, separate special objects registry " "The Special Objects Array is an array of objects used by the Squeak virtual machine. Its contents are critical and accesses to it by the VM are unchecked, so don't even think of playing here unless you know what you are doing." | newArray | newArray := Array new: 56. "Nil false and true get used throughout the interpreter" newArray at: 1 put: nil. newArray at: 2 put: false. newArray at: 3 put: true. "This association holds the active process (a ProcessScheduler)" + newArray at: 4 put: (self bindingOf: #Processor). - newArray at: 4 put: (self associationAt: #Processor). "Numerous classes below used for type checking and instantiation" newArray at: 5 put: Bitmap. newArray at: 6 put: SmallInteger. newArray at: 7 put: ByteString. newArray at: 8 put: Array. newArray at: 9 put: Smalltalk. newArray at: 10 put: Float. newArray at: 11 put: MethodContext. newArray at: 12 put: BlockContext. newArray at: 13 put: Point. newArray at: 14 put: LargePositiveInteger. newArray at: 15 put: Display. newArray at: 16 put: Message. newArray at: 17 put: CompiledMethod. newArray at: 18 put: (self specialObjectsArray at: 18). "(low space Semaphore)" newArray at: 19 put: Semaphore. newArray at: 20 put: Character. newArray at: 21 put: #doesNotUnderstand:. newArray at: 22 put: #cannotReturn:. newArray at: 23 put: nil. "This is the process signalling low space." "An array of the 32 selectors that are compiled as special bytecodes, paired alternately with the number of arguments each takes." newArray at: 24 put: #( #+ 1 #- 1 #< 1 #> 1 #<= 1 #>= 1 #= 1 #~= 1 #* 1 #/ 1 #\\ 1 #@ 1 #bitShift: 1 #// 1 #bitAnd: 1 #bitOr: 1 #at: 1 #at:put: 2 #size 0 #next 0 #nextPut: 1 #atEnd 0 #== 1 #class 0 #blockCopy: 1 #value 0 #value: 1 #do: 1 #new 0 #new: 1 #x 0 #y 0 ). "An array of the 255 Characters in ascii order. Cog inlines table into machine code at: prim so do not regenerate it." newArray at: 25 put: (self specialObjectsArray at: 25). newArray at: 26 put: #mustBeBoolean. newArray at: 27 put: ByteArray. newArray at: 28 put: Process. "An array of up to 31 classes whose instances will have compact headers" newArray at: 29 put: self compactClassesArray. newArray at: 30 put: (self specialObjectsArray at: 30). "(delay Semaphore)" newArray at: 31 put: (self specialObjectsArray at: 31). "(user interrupt Semaphore)" "Entries 32 - 34 unreferenced. Previously these contained prototype instances to be copied for fast initialization" newArray at: 32 put: nil. "was (Float new: 2)" newArray at: 33 put: nil. "was (LargePositiveInteger new: 4)" newArray at: 34 put: nil. "was Point new" newArray at: 35 put: #cannotInterpret:. "Note: This must be fixed once we start using context prototypes (yeah, right)" "(MethodContext new: CompiledMethod fullFrameSize)." newArray at: 36 put: (self specialObjectsArray at: 36). "Is the prototype MethodContext (unused by the VM)" newArray at: 37 put: BlockClosure. "(BlockContext new: CompiledMethod fullFrameSize)." newArray at: 38 put: (self specialObjectsArray at: 38). "Is the prototype BlockContext (unused by the VM)" "array of objects referred to by external code" newArray at: 39 put: (self specialObjectsArray at: 39). "preserve external semaphores" newArray at: 40 put: nil. "Reserved for Mutex in Cog VMs" newArray at: 41 put: nil. "Reserved for a LinkedList instance for overlapped calls in CogMT" "finalization Semaphore" newArray at: 42 put: ((self specialObjectsArray at: 42) ifNil: [Semaphore new]). newArray at: 43 put: LargeNegativeInteger. "External objects for callout. Note: Written so that one can actually completely remove the FFI." newArray at: 44 put: (self at: #ExternalAddress ifAbsent: []). newArray at: 45 put: (self at: #ExternalStructure ifAbsent: []). newArray at: 46 put: (self at: #ExternalData ifAbsent: []). newArray at: 47 put: (self at: #ExternalFunction ifAbsent: []). newArray at: 48 put: (self at: #ExternalLibrary ifAbsent: []). newArray at: 49 put: #aboutToReturn:through:. newArray at: 50 put: #run:with:in:. "51 reserved for immutability message" "newArray at: 51 put: #attemptToAssign:withIndex:." newArray at: 52 put: #(nil "nil => generic error" #'bad receiver' #'bad argument' #'bad index' #'bad number of arguments' #'inappropriate operation' #'unsupported operation' #'no modification' #'insufficient object memory' #'insufficient C memory' #'not found' #'bad method' #'internal error in named primitive machinery' #'object may move'). "53 to 55 are for Alien" newArray at: 53 put: (self at: #Alien ifAbsent: []). newArray at: 54 put: #invokeCallback:stack:registers:jmpbuf:. newArray at: 55 put: (self at: #UnsafeAlien ifAbsent: []). "Weak reference finalization" newArray at: 56 put: (self at: #WeakFinalizationList ifAbsent: []). "Now replace the interpreter's reference in one atomic operation" self specialObjectsArray becomeForward: newArray ! Item was changed: ----- Method: SmalltalkImage>>unloadAllKnownPackages (in category 'shrinking') ----- unloadAllKnownPackages "Unload all packages we know how to unload and reload" "Prepare unloading" Smalltalk zapMVCprojects. Flaps disableGlobalFlaps: false. StandardScriptingSystem removeUnreferencedPlayers. Project removeAllButCurrent. #('Morphic-UserObjects' 'EToy-UserObjects' 'Morphic-Imported' ) do: [:each | SystemOrganization removeSystemCategory: each]. Smalltalk at: #ServiceRegistry ifPresent:[:aClass| SystemChangeNotifier uniqueInstance noMoreNotificationsFor: aClass. ]. World removeAllMorphs. "Go unloading" #( 'ReleaseBuilder' 'ScriptLoader' '311Deprecated' '39Deprecated' 'Universes' 'SMLoader' 'SMBase' 'Installer-Core' 'VersionNumberTests' 'VersionNumber' 'Services-Base' 'PreferenceBrowser' 'Nebraska' 'ToolBuilder-MVC' 'ST80' 'CollectionsTests' 'GraphicsTests' 'KernelTests' 'MorphicTests' 'MultilingualTests' 'NetworkTests' 'ToolsTests' 'TraitsTests' 'SystemChangeNotification-Tests' 'FlexibleVocabularies' 'EToys' 'Protocols' 'XML-Parser' 'Tests' 'SUnitGUI' 'Help-Squeak' 'HelpSystem' 'SystemReporter' ) do: [:pkgName| (MCPackage named: pkgName) unload. MCMcmUpdater disableUpdatesOfPackage: pkgName. ]. "Traits use custom unload" Smalltalk at: #Trait ifPresent:[:aClass| aClass unloadTraits]. "Post-unload cleanup" MCWorkingCopy flushObsoletePackageInfos. SystemOrganization removeSystemCategory: 'UserObjects'. Presenter defaultPresenterClass: nil. World dumpPresenter. ScheduledControllers := nil. Preferences removePreference: #allowEtoyUserCustomEvents. SystemOrganization removeEmptyCategories. ChangeSet removeChangeSetsNamedSuchThat:[:cs | (cs == ChangeSet current) not]. + globals undeclared removeUnreferencedKeys. - Undeclared removeUnreferencedKeys. StandardScriptingSystem initialize. MCFileBasedRepository flushAllCaches. MCDefinition clearInstances. Behavior flushObsoleteSubclasses. ChangeSet current clear. ChangeSet current name: 'Unnamed1'. Smalltalk flushClassNameCache. Smalltalk at: #Browser ifPresent:[:br| br initialize]. DebuggerMethodMap voidMapCache. DataStream initialize. AppRegistry removeObsolete. FileServices removeObsolete. Preferences removeObsolete. TheWorldMenu removeObsolete. Smalltalk garbageCollect. Symbol compactSymbolTable. TheWorldMainDockingBar updateInstances. MorphicProject defaultFill: (Color gray: 0.9). World color: (Color gray: 0.9). ! Item was changed: ----- Method: SystemDictionary>>at:put: (in category 'dictionary access') ----- at: aKey put: anObject "Override from Dictionary to check Undeclared and fix up references to undeclared variables." | index element | (self includesKey: aKey) ifFalse: + [self declare: aKey from: (self at: #Undeclared). - [self declare: aKey from: Undeclared. self flushClassNameCache]. super at: aKey put: anObject. ^ anObject!

1 0

The Trunk: Kernel-cwp.727.mcz
by commits＠source.squeak.org 02 Jan '13

02 Jan '13

Colin Putney uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-cwp.727.mcz ==================== Summary ==================== Name: Kernel-cwp.727 Author: cwp Time: 1 January 2013, 7:01:18.073 pm UUID: 035cc801-2619-49a8-965e-b61a1eada4e3 Ancestors: Kernel-cwp.726 Environments bootstrap - stage 3 =============== Diff against Kernel-cwp.726 =============== Item was changed: ----- Method: Class>>addClassVarName: (in category 'class variables') ----- addClassVarName: aString "Add the argument, aString, as a class variable of the receiver. Signal an error if the first character of aString is not capitalized, or if it is already a variable named in the class." | symbol oldState | oldState := self copy. aString first canBeGlobalVarInitial ifFalse: [^self error: aString, ' class variable name should be capitalized; proceed to include anyway.']. symbol := aString asSymbol. self withAllSubclasses do: [:subclass | (self canFindWithoutEnvironment: symbol) ifTrue: [ (DuplicateVariableError new) superclass: superclass; "fake!!!!!!" variable: aString; signal: aString, ' is already defined']]. classPool == nil ifTrue: [classPool := Dictionary new]. (classPool includesKey: symbol) ifFalse: ["Pick up any refs in Undeclared" + classPool declare: symbol from: environment undeclared. - classPool declare: symbol from: Undeclared. SystemChangeNotifier uniqueInstance classDefinitionChangedFrom: oldState to: self]! Item was changed: ----- Method: Class>>bindingOf: (in category 'compiling') ----- bindingOf: varName + ^ self bindingOf: varName environment: self environment! - "Answer the binding of some variable resolved in the scope of the receiver" - | aSymbol binding | - aSymbol := varName asSymbol. - - "First look in classVar dictionary." - binding := self classPool bindingOf: aSymbol. - binding ifNotNil:[^binding]. - - "Next look in shared pools." - self sharedPools do:[:pool | - binding := pool bindingOf: aSymbol. - binding ifNotNil:[^binding]. - ]. - - "Next look in declared environment." - binding := self environment bindingOf: aSymbol. - binding ifNotNil:[^binding]. - - "Finally look higher up the superclass chain and fail at the end." - superclass == nil - ifTrue: [^ nil] - ifFalse: [^ superclass bindingOf: aSymbol]. - - ! Item was changed: ----- Method: Class>>category (in category 'organization') ----- category "Answer the system organization category for the receiver. First check whether the category name stored in the ivar is still correct and only if this fails look it up (latter is much more expensive)" category ifNotNil: [ :symbol | + ((self environment organization listAtCategoryNamed: symbol) includes: self name) - ((SystemOrganization listAtCategoryNamed: symbol) includes: self name) ifTrue: [ ^symbol ] ]. + category := self environment organization categoryOfElement: self name. - category := SystemOrganization categoryOfElement: self name. ^category! Item was changed: ----- Method: Class>>declare: (in category 'initialize-release') ----- declare: varString "Declare class variables common to all instances. Answer whether recompilation is advisable." | newVars conflicts | newVars := (Scanner new scanFieldNames: varString) collect: [:x | x asSymbol]. newVars do: [:var | var first canBeGlobalVarInitial ifFalse: [self error: var, ' class variable name should be capitalized; proceed to include anyway.']]. conflicts := false. classPool == nil ifFalse: [(classPool keys reject: [:x | newVars includes: x]) do: [:var | self removeClassVarName: var]]. (newVars reject: [:var | self classPool includesKey: var]) do: [:var | "adding" "check if new vars defined elsewhere" (self canFindWithoutEnvironment: var) ifTrue: [ (DuplicateVariableError new) superclass: superclass; "fake!!!!!!" variable: var; signal: var, ' is already defined'. conflicts := true]]. newVars size > 0 ifTrue: [classPool := self classPool. "in case it was nil" + newVars do: [:var | classPool declare: var from: environment undeclared]]. - newVars do: [:var | classPool declare: var from: Undeclared]]. ^conflicts! Item was changed: ----- Method: Class>>removeClassVarName: (in category 'class variables') ----- removeClassVarName: aString "Remove the class variable whose name is the argument, aString, from the names defined in the receiver, a class. Create an error notification if aString is not a class variable or if it is still being used in the code of the class." | aSymbol | aSymbol := aString asSymbol. (classPool includesKey: aSymbol) ifFalse: [^self error: aString, ' is not a class variable']. self withAllSubclasses do:[:subclass | (Array with: subclass with: subclass class) do:[:classOrMeta | (classOrMeta whichSelectorsReferTo: (classPool associationAt: aSymbol)) isEmpty ifFalse: [ InMidstOfFileinNotification signal ifTrue: [ Transcript cr; show: self name, ' (' , aString , ' is Undeclared) '. + ^ environment undeclared declare: aSymbol from: classPool]. - ^Undeclared declare: aSymbol from: classPool]. (self confirm: (aString,' is still used in code of class ', classOrMeta name, '.\Is it okay to move it to Undeclared?') withCRs) ifTrue:[^Undeclared declare: aSymbol from: classPool] ifFalse:[^self]]]]. classPool removeKey: aSymbol. classPool isEmpty ifTrue: [classPool := nil]. ! Item was changed: ----- Method: Class>>rename: (in category 'class name') ----- rename: aString "The new name of the receiver is the argument, aString." | oldName newName | (newName := aString asSymbol) = (oldName := self name) ifTrue: [^ self]. (self environment includesKey: newName) ifTrue: [^ self error: newName , ' already exists']. + (environment undeclared includesKey: newName) - (Undeclared includesKey: newName) ifTrue: [self inform: 'There are references to, ' , aString printString , ' from Undeclared. Check them after this change.']. name := newName. self environment renameClass: self from: oldName! Item was changed: ----- Method: ClassBuilder>>name:inEnvironment:subclassOf:type:instanceVariableNames:classVariableNames:poolDictionaries:category:unsafe: (in category 'class definition') ----- name: className inEnvironment: env subclassOf: newSuper type: type instanceVariableNames: instVarString classVariableNames: classVarString poolDictionaries: poolString category: category unsafe: unsafe "Define a new class in the given environment. If unsafe is true do not run any validation checks. This facility is provided to implement important system changes." | oldClass instVars classVars copyOfOldClass newClass | environ := env. instVars := Scanner new scanFieldNames: instVarString. classVars := (Scanner new scanFieldNames: classVarString) collect: [:x | x asSymbol]. "Validate the proposed name" unsafe ifFalse:[(self validateClassName: className) ifFalse:[^nil]]. oldClass := env at: className ifAbsent:[nil]. oldClass isBehavior ifFalse: [oldClass := nil] "Already checked in #validateClassName:" ifTrue: [ copyOfOldClass := oldClass copy. copyOfOldClass superclass addSubclass: copyOfOldClass]. [ | newCategory needNew force organization oldCategory | unsafe ifFalse:[ "Run validation checks so we know that we have a good chance for recompilation" (self validateSuperclass: newSuper forSubclass: oldClass) ifFalse:[^nil]. (self validateInstvars: instVars from: oldClass forSuper: newSuper) ifFalse:[^nil]. (self validateClassvars: classVars from: oldClass forSuper: newSuper) ifFalse:[^nil]. (self validateSubclassFormat: type from: oldClass forSuper: newSuper extra: instVars size) ifFalse:[^nil]]. "See if we need a new subclass" needNew := self needsSubclassOf: newSuper type: type instanceVariables: instVars from: oldClass. needNew == nil ifTrue:[^nil]. "some error" (needNew and:[unsafe not]) ifTrue:[ "Make sure we don't redefine any dangerous classes" (self tooDangerousClasses includes: oldClass name) ifTrue:[ self error: oldClass name, ' cannot be changed'. ]. "Check if the receiver should not be redefined" (oldClass ~~ nil and:[oldClass shouldNotBeRedefined]) ifTrue:[ self notify: oldClass name asText allBold, ' should not be redefined. \Proceed to store over it.' withCRs]]. needNew ifTrue:[ "Create the new class" newClass := self newSubclassOf: newSuper type: type instanceVariables: instVars from: oldClass. newClass == nil ifTrue:[^nil]. "Some error" newClass setName: className. + newClass environment: environ. ] ifFalse:[ "Reuse the old class" newClass := oldClass. ]. "Install the class variables and pool dictionaries... " force := (newClass declare: classVarString) | (newClass sharing: poolString). "... classify ..." newCategory := category asSymbol. organization := environ ifNotNil:[environ organization]. oldClass isNil ifFalse: [oldCategory := (organization categoryOfElement: oldClass name) asSymbol]. organization classify: newClass name under: newCategory suppressIfDefault: true. + - newClass environment: environ. - "... recompile ..." newClass := self recompile: force from: oldClass to: newClass mutate: false. "... export if not yet done ..." (environ at: newClass name ifAbsent:[nil]) == newClass ifFalse:[ [environ at: newClass name put: newClass] on: AttemptToWriteReadOnlyGlobal do:[:ex| ex resume: true]. environ flushClassNameCache. ]. newClass doneCompiling. "... notify interested clients ..." oldClass isNil ifTrue: [ SystemChangeNotifier uniqueInstance classAdded: newClass inCategory: newCategory. ^ newClass]. newCategory ~= oldCategory ifTrue: [SystemChangeNotifier uniqueInstance class: newClass recategorizedFrom: oldCategory to: category] ifFalse: [SystemChangeNotifier uniqueInstance classDefinitionChangedFrom: copyOfOldClass to: newClass.]. ] ensure: [copyOfOldClass ifNotNil: [copyOfOldClass superclass removeSubclass: copyOfOldClass]. Behavior flushObsoleteSubclasses. ]. ^newClass! Item was changed: ----- Method: ClassBuilder>>superclass:subclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'public') ----- superclass: newSuper subclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat "This is the standard initialization message for creating a new class as a subclass of an existing class." + | env | + env := EnvironmentRequest signal ifNil: [newSuper environment]. ^self name: t + inEnvironment: env - inEnvironment: newSuper environment subclassOf: newSuper type: newSuper typeOfClass instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat! Item was changed: ----- Method: ClassBuilder>>superclass:variableByteSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'public') ----- superclass: aClass variableByteSubclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat "This is the standard initialization message for creating a new class as a subclass of an existing class in which the subclass is to have indexable byte-sized nonpointer variables." + | oldClassOrNil actualType env | - | oldClassOrNil actualType | (aClass instSize > 0) ifTrue: [^self error: 'cannot make a byte subclass of a class with named fields']. (aClass isVariable and: [aClass isWords]) ifTrue: [^self error: 'cannot make a byte subclass of a class with word fields']. (aClass isVariable and: [aClass isPointers]) ifTrue: [^self error: 'cannot make a byte subclass of a class with pointer fields']. oldClassOrNil := aClass environment at: t ifAbsent:[nil]. actualType := (oldClassOrNil notNil and: [oldClassOrNil typeOfClass == #compiledMethod]) ifTrue: [#compiledMethod] ifFalse: [#bytes]. + env := EnvironmentRequest signal ifNil: [aClass environment]. ^self name: t + inEnvironment: env - inEnvironment: aClass environment subclassOf: aClass type: actualType instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat! Item was changed: ----- Method: ClassBuilder>>superclass:variableSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'public') ----- superclass: aClass variableSubclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat "This is the standard initialization message for creating a new class as a subclass of an existing class in which the subclass is to have indexable pointer variables." + + | env | + aClass isBits ifTrue: + [^self error: 'cannot make a pointer subclass of a class with non-pointer fields']. + env := EnvironmentRequest signal ifNil: [aClass environment]. - aClass isBits - ifTrue: [^self error: 'cannot make a pointer subclass of a class with non-pointer fields']. ^self name: t + inEnvironment: env - inEnvironment: aClass environment subclassOf: aClass type: #variable instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat! Item was changed: ----- Method: ClassBuilder>>superclass:variableWordSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'public') ----- superclass: aClass variableWordSubclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat "This is the standard initialization message for creating a new class as a subclass of an existing class in which the subclass is to have indexable word-sized nonpointer variables." + | env | (aClass instSize > 0) ifTrue: [^self error: 'cannot make a word subclass of a class with named fields']. (aClass isVariable and: [aClass isBytes]) ifTrue: [^self error: 'cannot make a word subclass of a class with byte fields']. (aClass isVariable and: [aClass isPointers]) ifTrue: [^self error: 'cannot make a word subclass of a class with pointer fields']. + env := EnvironmentRequest signal ifNil: [aClass environment]. - ^self name: t + inEnvironment: env - inEnvironment: aClass environment subclassOf: aClass type: #words instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat! Item was changed: ----- Method: ClassBuilder>>superclass:weakSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'public') ----- superclass: aClass weakSubclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat "This is the standard initialization message for creating a new class as a subclass of an existing class (the receiver) in which the subclass is to have weak indexable pointer variables." + | env | aClass isBits ifTrue: [^self error: 'cannot make a pointer subclass of a class with non-pointer fields']. + env := EnvironmentRequest signal ifNil: [aClass environment]. ^self name: t + inEnvironment: env - inEnvironment: aClass environment subclassOf: aClass type: #weak instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat!

1 0

The Trunk: Environments-cwp.8.mcz
by commits＠source.squeak.org 02 Jan '13

02 Jan '13

Colin Putney uploaded a new version of Environments to project The Trunk: http://source.squeak.org/trunk/Environments-cwp.8.mcz ==================== Summary ==================== Name: Environments-cwp.8 Author: cwp Time: 1 January 2013, 7:00:24.118 pm UUID: 0abedc80-5737-42fb-babd-6b2d69f1b352 Ancestors: Environments-cwp.7 Environments bootstrap - stage 3 =============== Diff against Environments-cwp.7 =============== Item was changed: ----- Method: Environment>>fileIn:announcing: (in category 'operations') ----- fileIn: aStream announcing: aString + (EnvironmentLoader for: self) - self shouldBeImplemented. - " (EnvironmentLoader for: self) fileIn: aStream announcing: aString + ! - "! Item was added: + Object subclass: #EnvironmentLoader + instanceVariableNames: 'environment' + classVariableNames: '' + poolDictionaries: '' + category: 'Environments-Core'! Item was added: + ----- Method: EnvironmentLoader class>>for: (in category 'as yet unclassified') ----- + for: anEnvironment + ^ self basicNew initializeWithEnvironment: anEnvironment! Item was added: + ----- Method: EnvironmentLoader>>evaluate:logged: (in category 'as yet unclassified') ----- + evaluate: chunk logged: aBoolean + ^ [Compiler evaluate: chunk environment: environment logged: aBoolean] + on: EnvironmentRequest + do: [:req | req resume: environment]! Item was added: + ----- Method: EnvironmentLoader>>fileIn:announcing: (in category 'as yet unclassified') ----- + fileIn: aStream announcing: aString + | val | + self logStart: aStream name. + aString displayProgressFrom: 0 to: aStream size during: + [:bar | + [aStream atEnd] whileFalse: + [bar value: aStream position. + aStream skipSeparators. + [val := self fileInChunkFrom: aStream] + on: InMidstOfFileinNotification + do: [:ex | ex resume: true]. + aStream skipStyleChunk]. + aStream close]. + self logEnd: aStream name. + ^ val! Item was added: + ----- Method: EnvironmentLoader>>fileInChunkFrom: (in category 'as yet unclassified') ----- + fileInChunkFrom: aStream + | chunk | + ^ (aStream peekFor: $!!) + ifTrue: [ + | reader | + chunk := aStream nextChunk. + reader := self evaluate: chunk logged: false. + reader scanFrom: aStream environment: environment] + ifFalse: [ + chunk := aStream nextChunk. + aStream checkForPreamble: chunk. + self evaluate: chunk logged: true ]! Item was added: + ----- Method: EnvironmentLoader>>initializeWithEnvironment: (in category 'as yet unclassified') ----- + initializeWithEnvironment: anEnvironment + self initialize. + environment := anEnvironment! Item was added: + ----- Method: EnvironmentLoader>>logEnd: (in category 'as yet unclassified') ----- + logEnd: filename + "Note: The main purpose of this banner is to flush the changes file." + SmalltalkImage current logChange: '----End fileIn of ' , filename , ' into ', environment name, '----' ! Item was added: + ----- Method: EnvironmentLoader>>logStart: (in category 'as yet unclassified') ----- + logStart: filename + SmalltalkImage current logChange: '----Start fileIn of ' , filename , ' into ' , environment name , '----'! Item was added: + Notification subclass: #EnvironmentRequest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Environments-Core'!

1 0

Jump to page: