--- a/Class.st Tue Feb 06 17:29:57 1996 +0100
+++ b/Class.st Wed Feb 07 15:08:16 1996 +0100
@@ -15,8 +15,7 @@
history'
classVariableNames:'UpdatingChanges LockChangesFile FileOutErrorSignal
CatchMethodRedefinitions MethodRedefinitionSignal
- UpdateChangeFileQuerySignal
- TryLocalSourceFirst'
+ UpdateChangeFileQuerySignal TryLocalSourceFirst'
poolDictionaries:''
category:'Kernel-Classes'
!
@@ -205,6 +204,18 @@
^ prev
!
+tryLocalSourceFirst
+ ^ TryLocalSourceFirst
+
+ "Created: 24.1.1996 / 19:55:35 / cg"
+!
+
+tryLocalSourceFirst:aBoolean
+ TryLocalSourceFirst := aBoolean
+
+ "Created: 24.1.1996 / 19:55:35 / cg"
+!
+
updateChanges:aBoolean
"turn on/off changes management. Return the prior value of the flag.
This value is used as a default fallback - a querySignal handler may still
@@ -223,18 +234,6 @@
decide to return something else."
^ UpdatingChanges
-!
-
-tryLocalSourceFirst:aBoolean
- TryLocalSourceFirst := aBoolean
-
- "Created: 24.1.1996 / 19:55:35 / cg"
-!
-
-tryLocalSourceFirst
- ^ TryLocalSourceFirst
-
- "Created: 24.1.1996 / 19:55:35 / cg"
! !
!Class class methodsFor:'enumeration '!
@@ -878,27 +877,29 @@
self wasAutoloaded ifFalse:[
- "
- can it be done ?
- "
- self methodArray do:[:aMethod |
- aMethod source isNil ifTrue:[^false].
- aMethod hasPrimitiveCode ifTrue:[^ false].
- ].
+ "
+ can it be done ?
+ "
+ self methodArray do:[:aMethod |
+ aMethod source isNil ifTrue:[^false].
+ aMethod hasPrimitiveCode ifTrue:[^ false].
+ ].
].
self allSubclassesDo:[:aClass |
- aClass unload
+ aClass unload
].
- Transcript showCr:'unloading ' , name.
+ Transcript showCr:'unloading ' , name , ' ...'.
Autoload removeClass:self.
nm := name.
Smalltalk at:nm put:nil.
- name := nm , ' (leftover)'.
+"/ name := (nm , ' (leftover)') asSymbol.
ObjectMemory flushInlineCaches.
ObjectMemory flushMethodCache.
Autoload addClass:nm inCategory:category.
+"/ category := #unloaded.
+ Smalltalk flushCachedClasses.
^ true
"
@@ -907,6 +908,8 @@
ClockView unload.
Clock open
"
+
+ "Modified: 7.2.1996 / 15:05:39 / cg"
! !
!Class methodsFor:'binary storage'!
@@ -921,67 +924,122 @@
"
!
-storeBinaryDefinitionOf: anAssociation on: stream manager: manager
- "not usable at the moment - there are no classpools currently"
-
- | string |
-
- string := self name, ' classPool at: ', anAssociation key storeString.
- stream nextNumber: 2 put: string size.
- string do: [:char| stream nextPut: char asciiValue]
-!
-
-storeBinaryDefinitionOn: stream manager: manager
- "classes only store the name, signature and instvar names.
- They restore by looking for that name in the Smalltalk dictionary.
- However, using the signature, a check for being valid is made at
- restore time.
- This avoids a full recursive store of a class in the normal binary
- storage - however, it also means that a classes semantics cannot
- be stored with the basic storeBinary operation
- (we depend on the class being present at binaryLoad time.
- To store classes, use #storeBinaryClassOn:manager: or BOSS>>nextPutClasses:."
-
- |varnames n sz|
-
- "
- output the signature
- "
- stream nextNumber:4 put:self signature.
-
- "
- output the instance variable name string
- "
- varnames := self allInstVarNames.
- n := varnames size.
- n == 0 ifTrue:[
- sz := 0
- ] ifFalse:[
- sz := varnames inject:0 into:[:sum :nm | sum + nm size].
- sz := sz + n - 1.
+binaryClassDefinitionFrom:stream manager:manager
+ "retrieve a class as stored previously with
+ #storeBinaryClassOn:manager:"
+
+ |superclassName name flags instvars classvars category classInstVars
+ comment package nSel sel lastCategory
+ newClass superClass selectors methods cselectors cmethods|
+
+ "/ the following order must correlate to
+ "/ the storing in #storeBinaryClassOn:manager:
+
+ "/ retrieve
+ "/ superclasses name,
+ "/ name,
+ "/ typeSymbol,
+ "/ instVarNames
+ "/ classVarNames
+ "/ category
+ "/ classInstVarNames
+ "/ comment
+ "/ package
+
+ superclassName := manager nextObject.
+ superclassName notNil ifTrue:[
+ superClass := Smalltalk at:superclassName ifAbsent:nil.
+ ].
+ superClass notNil ifTrue:[
+"/ ('loading superclass: ' , superclassName ) printNL.
+ superClass autoload.
+ superClass := Smalltalk at:superclassName.
].
- stream nextNumber:2 put:sz.
- varnames keysAndValuesDo:[:i :nm |
- nm do:[:c |
- stream nextPut:c asciiValue
- ].
- i ~~ n ifTrue:[stream nextPut:(Character space asciiValue)]
+
+ name := manager nextObject.
+ flags := manager nextObject.
+ instvars := manager nextObject.
+ instvars isNil ifTrue:[instvars := ''].
+ classvars := manager nextObject.
+ classvars isNil ifTrue:[classvars := ''].
+ category := manager nextObject.
+ classInstVars := manager nextObject.
+ classInstVars isNil ifTrue:[classInstVars := ''].
+ comment := manager nextObject.
+ package := manager nextObject.
+
+"/ 'got superName:' print. superclassName printNL.
+"/ 'got name:' print. name printNL.
+"/ 'got flags: ' print. flags printNL.
+"/ 'got instvars: ' print. instvars printNL.
+"/ 'got classvars: ' print. classvars printNL.
+"/ 'got category: ' print. category printNL.
+"/ 'got classInstvars: ' print. classInstVars printNL.
+
+"/ ('create class: ' , name ) printNL.
+
+ (superClass notNil or:[superclassName isNil]) ifTrue:[
+ newClass := superClass class
+ name:name asSymbol
+ inEnvironment:Smalltalk
+ subclassOf:superClass
+ instanceVariableNames:instvars
+ variable:false
+ words:false
+ pointers:true
+ classVariableNames:classvars
+ poolDictionaries:''
+ category:category
+ comment:comment
+ changed:false
+ classInstanceVariableNames:classInstVars.
+ newClass flags:flags.
].
- "
- output my name
- "
- stream nextNumber:2 put:name size.
- name do:[:c|
- stream nextPut:c asciiValue
- ]
-
- "
- |s|
- s := WriteStream on:ByteArray new.
- Rectangle storeBinaryOn:s.
- Object readBinaryFrom:(ReadStream on:s contents)
- "
+ "/ retrieve
+ "/ number of class methods
+
+ cselectors := manager nextObject.
+ nSel := cselectors size.
+ cmethods := Array new:nSel.
+
+ "/ retrieve
+ "/ class methods
+ 1 to:nSel do:[:i |
+ |m|
+
+ m := Method binaryFullDefinitionFrom:stream manager:manager.
+ cmethods at:i put:m.
+ ].
+
+ "/ retrieve
+ "/ number of inst methods
+
+ selectors := manager nextObject.
+ nSel := selectors size.
+ methods := Array new:nSel.
+
+ "/ retrieve
+ "/ inst methods
+ 1 to:nSel do:[:i |
+ |m|
+
+ m := Method binaryFullDefinitionFrom:stream manager:manager.
+ methods at:i put:m.
+ ].
+
+ (superClass isNil and:[superclassName notNil]) ifTrue:[^ nil].
+ newClass isNil ifTrue:[
+ ^ nil
+ ].
+"/ newClass class instanceVariableNames:classInstVars.
+
+ newClass package:package.
+ newClass selectors:selectors methods:methods.
+ newClass class selectors:cselectors methods:cmethods.
+ ^ newClass
+
+ "Modified: 22.1.1996 / 13:22:08 / cg"
!
storeBinaryClassOn:stream manager:manager
@@ -1104,122 +1162,67 @@
"Modified: 16.1.1996 / 17:01:05 / cg"
!
-binaryClassDefinitionFrom:stream manager:manager
- "retrieve a class as stored previously with
- #storeBinaryClassOn:manager:"
-
- |superclassName name flags instvars classvars category classInstVars
- comment package nSel sel lastCategory
- newClass superClass selectors methods cselectors cmethods|
-
- "/ the following order must correlate to
- "/ the storing in #storeBinaryClassOn:manager:
-
- "/ retrieve
- "/ superclasses name,
- "/ name,
- "/ typeSymbol,
- "/ instVarNames
- "/ classVarNames
- "/ category
- "/ classInstVarNames
- "/ comment
- "/ package
-
- superclassName := manager nextObject.
- superclassName notNil ifTrue:[
- superClass := Smalltalk at:superclassName ifAbsent:nil.
- ].
- superClass notNil ifTrue:[
-"/ ('loading superclass: ' , superclassName ) printNL.
- superClass autoload.
- superClass := Smalltalk at:superclassName.
+storeBinaryDefinitionOf: anAssociation on: stream manager: manager
+ "not usable at the moment - there are no classpools currently"
+
+ | string |
+
+ string := self name, ' classPool at: ', anAssociation key storeString.
+ stream nextNumber: 2 put: string size.
+ string do: [:char| stream nextPut: char asciiValue]
+!
+
+storeBinaryDefinitionOn: stream manager: manager
+ "classes only store the name, signature and instvar names.
+ They restore by looking for that name in the Smalltalk dictionary.
+ However, using the signature, a check for being valid is made at
+ restore time.
+ This avoids a full recursive store of a class in the normal binary
+ storage - however, it also means that a classes semantics cannot
+ be stored with the basic storeBinary operation
+ (we depend on the class being present at binaryLoad time.
+ To store classes, use #storeBinaryClassOn:manager: or BOSS>>nextPutClasses:."
+
+ |varnames n sz|
+
+ "
+ output the signature
+ "
+ stream nextNumber:4 put:self signature.
+
+ "
+ output the instance variable name string
+ "
+ varnames := self allInstVarNames.
+ n := varnames size.
+ n == 0 ifTrue:[
+ sz := 0
+ ] ifFalse:[
+ sz := varnames inject:0 into:[:sum :nm | sum + nm size].
+ sz := sz + n - 1.
].
-
- name := manager nextObject.
- flags := manager nextObject.
- instvars := manager nextObject.
- instvars isNil ifTrue:[instvars := ''].
- classvars := manager nextObject.
- classvars isNil ifTrue:[classvars := ''].
- category := manager nextObject.
- classInstVars := manager nextObject.
- classInstVars isNil ifTrue:[classInstVars := ''].
- comment := manager nextObject.
- package := manager nextObject.
-
-"/ 'got superName:' print. superclassName printNL.
-"/ 'got name:' print. name printNL.
-"/ 'got flags: ' print. flags printNL.
-"/ 'got instvars: ' print. instvars printNL.
-"/ 'got classvars: ' print. classvars printNL.
-"/ 'got category: ' print. category printNL.
-"/ 'got classInstvars: ' print. classInstVars printNL.
-
-"/ ('create class: ' , name ) printNL.
-
- (superClass notNil or:[superclassName isNil]) ifTrue:[
- newClass := superClass class
- name:name asSymbol
- inEnvironment:Smalltalk
- subclassOf:superClass
- instanceVariableNames:instvars
- variable:false
- words:false
- pointers:true
- classVariableNames:classvars
- poolDictionaries:''
- category:category
- comment:comment
- changed:false
- classInstanceVariableNames:classInstVars.
- newClass flags:flags.
+ stream nextNumber:2 put:sz.
+ varnames keysAndValuesDo:[:i :nm |
+ nm do:[:c |
+ stream nextPut:c asciiValue
+ ].
+ i ~~ n ifTrue:[stream nextPut:(Character space asciiValue)]
].
- "/ retrieve
- "/ number of class methods
-
- cselectors := manager nextObject.
- nSel := cselectors size.
- cmethods := Array new:nSel.
-
- "/ retrieve
- "/ class methods
- 1 to:nSel do:[:i |
- |m|
-
- m := Method binaryFullDefinitionFrom:stream manager:manager.
- cmethods at:i put:m.
- ].
-
- "/ retrieve
- "/ number of inst methods
-
- selectors := manager nextObject.
- nSel := selectors size.
- methods := Array new:nSel.
-
- "/ retrieve
- "/ inst methods
- 1 to:nSel do:[:i |
- |m|
-
- m := Method binaryFullDefinitionFrom:stream manager:manager.
- methods at:i put:m.
- ].
-
- (superClass isNil and:[superclassName notNil]) ifTrue:[^ nil].
- newClass isNil ifTrue:[
- ^ nil
- ].
-"/ newClass class instanceVariableNames:classInstVars.
-
- newClass package:package.
- newClass selectors:selectors methods:methods.
- newClass class selectors:cselectors methods:cmethods.
- ^ newClass
-
- "Modified: 22.1.1996 / 13:22:08 / cg"
+ "
+ output my name
+ "
+ stream nextNumber:2 put:name size.
+ name do:[:c|
+ stream nextPut:c asciiValue
+ ]
+
+ "
+ |s|
+ s := WriteStream on:ByteArray new.
+ Rectangle storeBinaryOn:s.
+ Object readBinaryFrom:(ReadStream on:s contents)
+ "
! !
!Class methodsFor:'c function interfacing'!
@@ -1984,28 +1987,6 @@
self binaryFileOutWithSourceMode:#reference
!
-binaryFileOutWithSourceMode:sourceMode
- "create a file 'class.cls' consisting of all methods in myself
- in a portable binary format.
- The argument controls how sources are to be saved:
- #keep - include the source
- #reference - include a reference to the sourceFile
- #discard - dont save sources.
-
- With #reference, the sourceFile needs to be present after reload
- in order to be browsable."
-
- |baseName fileName aStream|
-
- baseName := (Smalltalk fileNameForClass:self name).
- fileName := baseName , '.cls'.
- aStream := FileStream newFileNamed:fileName.
-
- aStream binary.
- self binaryFileOutOn:aStream sourceMode:sourceMode.
- aStream close.
-!
-
binaryFileOutOn:aStream
"append a binary representation of myself to aStream"
@@ -2031,6 +2012,28 @@
bos close.
!
+binaryFileOutWithSourceMode:sourceMode
+ "create a file 'class.cls' consisting of all methods in myself
+ in a portable binary format.
+ The argument controls how sources are to be saved:
+ #keep - include the source
+ #reference - include a reference to the sourceFile
+ #discard - dont save sources.
+
+ With #reference, the sourceFile needs to be present after reload
+ in order to be browsable."
+
+ |baseName fileName aStream|
+
+ baseName := (Smalltalk fileNameForClass:self name).
+ fileName := baseName , '.cls'.
+ aStream := FileStream newFileNamed:fileName.
+
+ aStream binary.
+ self binaryFileOutOn:aStream sourceMode:sourceMode.
+ aStream close.
+!
+
fileOut
"create a file 'class.st' consisting of all methods in myself in
sourceForm, from which the class can be reconstructed (by filing in).
@@ -2946,6 +2949,11 @@
]
!
+askIfUpdatingChanges
+ UpdateChangeFileQuerySignal isHandled ifFalse:[^ UpdatingChanges].
+ ^ UpdateChangeFileQuerySignal raise
+!
+
getPrimitiveSpecsAt:index
"return a primitiveSpecification component as string or nil"
@@ -2980,11 +2988,6 @@
primitiveSpec := Array new:3
].
primitiveSpec at:index put:aString
-!
-
-askIfUpdatingChanges
- UpdateChangeFileQuerySignal isHandled ifFalse:[^ UpdatingChanges].
- ^ UpdateChangeFileQuerySignal raise
! !
!Class methodsFor:'queries'!
@@ -3130,7 +3133,8 @@
The info returned consists of a dictionary
filled with (at least) values at: #module, #directory and #library.
If no such info is present in the class, nil is returned.
- (this happens with autoloaded and filed0in classes)
+ (this happens with autoloaded and filed-in classes)
+ Auotloaded classes set their package from the revisionInfo, if present.
By convention, this info is encoded in the classes package
string (which is given as argument to stc) as the last word in parenthesis.
@@ -3144,10 +3148,10 @@
(this is done for backward compatibility,)
For example:
- '....(libbasic)' -> module: stx directory: libbasic library: libbasic
- '....(stx:libbasic)' -> module: stx directory: libbasic library: libbasic
- '....(aeg:libIECInterface)' -> module: aeg directory: libIECInterface library:libIECInterface
- '....(stx:goodies/persistency:libdbase)' -> module: stx directory: goodies/persistency library:libdbase
+ '....(libbasic)' -> module: stx directory: libbasic library: libbasic
+ '....(stx:libbasic)' -> module: stx directory: libbasic library: libbasic
+ '....(aeg:libIECInterface)' -> module: aeg directory: libIECInterface library:libIECInterface
+ '....(stx:goodies/persistency:libdbase)' -> module: stx directory: goodies/persistency library:libdbase
The way how the sourceCodeManager uses this to find the source location
depends on the scheme used. For CVS, the module is taken as the -d arg,
@@ -3155,7 +3159,7 @@
Other schemes may do things differently - these are not yet specified.
Caveat:
- Encoding this info in the package string seems somewhat kludgy.
+ Encoding this info in the package string seems somewhat kludgy.
"
|sourceInfo packageString idx1 idx2
@@ -3166,64 +3170,70 @@
packageString := package asString.
idx1 := packageString lastIndexOf:$(.
idx1 ~~ 0 ifTrue:[
- idx2 := packageString indexOf:$) startingAt:idx1+1.
- idx2 ~~ 0 ifTrue:[
- sourceInfo := packageString copyFrom:idx1 + 1 to:idx2 - 1
- ]
+ idx2 := packageString indexOf:$) startingAt:idx1+1.
+ idx2 ~~ 0 ifTrue:[
+ sourceInfo := packageString copyFrom:idx1 + 1 to:idx2 - 1
+ ]
].
sourceInfo isNil ifTrue:[^ nil].
components := sourceInfo asCollectionOfSubstringsSeparatedBy:$:.
components size == 0 ifTrue:[
- moduleString := 'stx'.
- directoryString := libraryString := ''.
- ^ nil
+ moduleString := 'stx'.
+ directoryString := libraryString := ''.
+ ^ nil
] ifFalse:[
- components size == 1 ifTrue:[
- "/ a single name given - the module becomes 'stx',
- "/ if the component includes slashes, its the directory
- "/ otherwise the library
- "/
- moduleString := 'stx'.
- directoryString := libraryString := components at:1.
- (libraryString includes:$/) ifTrue:[
- libraryString := libraryString asFilename baseName
- ]
- ] ifFalse:[
- components size == 2 ifTrue:[
- "/ two components - assume its the directory and the library
- moduleString := 'stx'.
- directoryString := components at:1.
- libraryString := components at:2.
- ] ifFalse:[
- "/ all components given
- moduleString := components at:1.
- directoryString := components at:2.
- libraryString := components at:3.
- ]
- ]
+ components size == 1 ifTrue:[
+ "/ a single name given - the module becomes 'stx',
+ "/ if the component includes slashes, its the directory
+ "/ otherwise the library
+ "/
+ moduleString := 'stx'.
+ directoryString := libraryString := components at:1.
+ (libraryString includes:$/) ifTrue:[
+ libraryString := libraryString asFilename baseName
+ ]
+ ] ifFalse:[
+ components size == 2 ifTrue:[
+ "/ two components - assume its the module and the directory;
+ "/ the library is assumed to be named after the directory
+ "/ except, if slashes are in the name; then the libraryname
+ "/ is the last component.
+ "/
+ moduleString := components at:1.
+ directoryString := libraryString := components at:2.
+ (libraryString includes:$/) ifTrue:[
+ libraryString := libraryString asFilename baseName
+ ]
+ ] ifFalse:[
+ "/ all components given
+ moduleString := components at:1.
+ directoryString := components at:2.
+ libraryString := components at:3.
+ ]
+ ]
].
libraryString isEmpty ifTrue:[
- directoryString notEmpty ifTrue:[
- libraryString := directoryString asFilename baseName
- ].
- libraryString isEmpty ifTrue:[
- "/ lets extract the library from the liblist file ...
- libraryString := Smalltalk libraryFileNameOfClass:self.
- libraryString isNil ifTrue:[^ nil].
- ]
+ directoryString notEmpty ifTrue:[
+ libraryString := directoryString asFilename baseName
+ ].
+ libraryString isEmpty ifTrue:[
+ "/ lets extract the library from the liblist file ...
+ libraryString := Smalltalk libraryFileNameOfClass:self.
+ libraryString isNil ifTrue:[^ nil].
+ ]
].
moduleString isEmpty ifTrue:[
- moduleString := 'stx'.
+ moduleString := 'stx'.
].
directoryString isEmpty ifTrue:[
- directoryString := libraryString.
+ directoryString := libraryString.
].
^ IdentityDictionary
- with:(#module->moduleString)
- with:(#directory->directoryString)
- with:(#library->libraryString)
+ with:(#module->moduleString)
+ with:(#directory->directoryString)
+ with:(#library->libraryString)
"
Object packageSourceCodeInfo
@@ -3235,7 +3245,7 @@
"
"Created: 4.11.1995 / 20:36:53 / cg"
- "Modified: 25.11.1995 / 18:29:31 / cg"
+ "Modified: 7.2.1996 / 14:26:31 / cg"
!
revision
@@ -3380,6 +3390,65 @@
"Created: 9.12.1995 / 17:05:17 / cg"
!
+setPackageFromRevision
+ "set my package from the info found in the revisionString if present.
+ This is used to set some useful packageInfo after autoloading
+ (otherwise, autoloaded classes/methods would go into your current
+ package - which is probably not a good idea)"
+
+ |info mgr dir lib mod p|
+
+ mgr := self sourceCodeManager.
+ mgr notNil ifTrue:[
+ info := mgr sourceInfoOfClass:self
+ ].
+
+ info notNil ifTrue:[
+ mod := info at:#module ifAbsent:nil. "/ stx, aeg, <your-organization>
+ dir := info at:#directory ifAbsent:nil. "/ libbasic, libtool ...
+ lib := info at:#library ifAbsent:dir.
+
+ p := ''.
+ mod notNil ifTrue:[
+ mod ~= 'stx' ifTrue:[
+ p := p , mod
+ ]
+ ].
+ dir notNil ifTrue:[
+ p notEmpty ifTrue:[p := p , ':'].
+ p := p , dir.
+ ].
+ lib notNil ifTrue:[
+ lib ~= dir ifTrue:[
+ p notEmpty ifTrue:[p := p , ':'].
+ p := p , lib.
+ ]
+ ].
+ p notEmpty ifTrue:[
+ p := '(' , p , ')'.
+
+ package notNil ifTrue:[
+ (name , ': changing packageID to ''' , p , '''') infoPrintNL.
+ ].
+ package := p.
+
+ methodArray do:[:aMethod |
+ aMethod package isNil ifTrue:[
+ aMethod package:p
+ ]
+ ]
+ ].
+ ].
+ ^ self
+
+ "
+ MemoryMonitor autoload.
+ MemoryMonitor setPackageFromRevision
+ "
+
+ "Modified: 7.2.1996 / 14:36:48 / cg"
+!
+
sourceStream
"return an open stream on my sourcefile, nil if that is not available"
@@ -3742,6 +3811,6 @@
!Class class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.132 1996-02-05 00:46:37 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.133 1996-02-07 14:08:16 cg Exp $'
! !
Class initialize!