[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Help-smalltalk] update STClassLoader
From: |
Paolo Bonzini |
Subject: |
[Help-smalltalk] update STClassLoader |
Date: |
Mon, 14 May 2007 16:36:18 +0200 |
User-agent: |
Thunderbird 2.0.0.0 (Macintosh/20070326) |
This patch updates STClassLoader to support more methods on the loaded
classes, and to support class "shapes" instead of the more limited
Smalltalk-80 "kinds".
Paolo
* looking for address@hidden/smalltalk--devo--2.2--patch-321 to compare with
* comparing to address@hidden/smalltalk--devo--2.2--patch-321
M compiler/STLoader.st
M compiler/STLoaderObjs.st
M TODO
M kernel/Behavior.st
* modified files
--- orig/TODO
+++ mod/TODO
@@ -1,8 +1,10 @@
-* 2.4
+* 3.0
-** implement SmallScript file-in?
+** implement new syntax (being done)
-** use VFS to (re)implement packages?
+** implement a better packaging system allowing zipped source files with
+XML package descriptions to be delivered and installed. Investigate
+basing it on the Virtual File System infrastructure.
** faster startup (done)
@@ -11,6 +13,7 @@
** upgrade XML parser for package files
*** support arch-dependent files that are installed in the image path
+
* sometime
** some kind of sandboxing (partly done)
@@ -25,6 +28,17 @@ in sync. Maybe with CVS support (see Sm
----------------------------------------------------------------------
+
+* bindings
+
+** zlib. use it to implement direct ZIP-file access in VFS.
+
+** IPv6. Not hard to do.
+
+** rss. would provide cool examples of XML.
+
+----------------------------------------------------------------------
+
* code auditing
** check endian-cleanness of ByteStream's float and double I/O.
@@ -77,18 +91,11 @@ outside #new and so on).
** follow the implementation lines of compiler/STLoader.st to implement
SIF file-in.
-** implement a better packaging system allowing zipped source files with
-XML package descriptions to be delivered and installed. Investigate
-using fastjar from gcj, and basing it on the Virtual File System
-infrastructure.
-
** make the smalltalk cpp work - nothing less, nothing more ;-)
** print entities correctly in the URIResolver. A file named abc&def
should print abc&def in the file list.
-** support IPv6. Not hard to do.
-
* emacs mode
--- orig/compiler/STLoader.st
+++ mod/compiler/STLoader.st
@@ -69,21 +69,31 @@ toEvaluate: interpretedSelector perform:
!STInterpreter methodsFor: 'overrides'!
+evaluationMethodFor: selector
+ | method class |
+ class := self class.
+ [
+ class evaluationMethods isNil ifFalse: [
+ method := class evaluationMethods at: selector ifAbsent: [ nil ].
+ method isNil ifFalse: [ ^method ].
+ ].
+ class == STInterpreter ifTrue: [ ^#unknownTo:selector:arguments: ].
+ class := class superclass
+ ] repeat
+!
+
evaluateStatement: node
- | receiver selector argumentNodes result |
- receiver := node receiver.
- selector := node selector.
- argumentNodes := node arguments.
-
- result := false.
- self class evaluationMethods at: selector ifPresent: [ :method |
- result := self
- perform: method
- with: receiver
- with: selector
- with: argumentNodes ].
+ | method |
+ method := self evaluationMethodFor: node selector.
+ ^self
+ perform: method
+ with: node receiver
+ with: node selector
+ with: node arguments
+!
- ^result
+unknownTo: receiver selector: selector arguments: argumentNodes
+ ^false
!
evaluate: node
@@ -101,9 +111,15 @@ evaluate: node
initialize
self
+ toEvaluate: #subclass:
+ perform: #doSubclass:selector:arguments:;
+
toEvaluate:
#subclass:instanceVariableNames:classVariableNames:poolDictionaries:category:
perform: #doSubclass:selector:arguments:;
+ toEvaluate:
#variable:subclass:instanceVariableNames:classVariableNames:poolDictionaries:category:
+ perform: #doSubclass:selector:arguments:;
+
toEvaluate:
#variableSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:
perform: #doSubclass:selector:arguments:;
@@ -122,11 +138,23 @@ initialize
toEvaluate: #current:
perform: #doSetNamespace:selector:arguments:;
+ toEvaluate: #import:
+ perform: #doImport:selector:arguments:;
+
+ toEvaluate: #category:
+ perform: #doSend:selector:arguments:;
+
toEvaluate: #comment:
- perform: #doComment:selector:arguments:;
+ perform: #doSend:selector:arguments:;
+
+ toEvaluate: #shape:
+ perform: #doSend:selector:arguments:;
+
+ toEvaluate: #addClassVarName:
+ perform: #doSend:selector:arguments:;
toEvaluate: #instanceVariableNames:
- perform: #doClassInstVars:selector:arguments:
+ perform: #doSend:selector:arguments:
! !
!STClassLoader class methodsFor: 'instance creation'!
@@ -193,26 +221,26 @@ doSubclass: receiver selector: selector
^false
!
-doComment: receiver selector: selector arguments: argumentNodes
- | class |
+doSend: receiver selector: selector arguments: argumentNodes
+ | isClass class |
(argumentNodes allSatisfy: [ :each | each isLiteral ])
ifFalse: [ ^false ].
- class := self resolveClass: receiver.
- class comment: argumentNodes first value.
+ isClass := receiver isMessage and: [ receiver selector = #class ].
+ class := isClass
+ ifTrue: [ (self resolveClass: receiver receiver) asMetaclass ]
+ ifFalse: [ self resolveClass: receiver ].
+
+ class perform: selector with: argumentNodes first value.
^false
!
-doClassInstVars: receiver selector: selector arguments: argumentNodes
- | class |
- (argumentNodes allSatisfy: [ :each | each isLiteral ])
- ifFalse: [ ^false ].
-
- receiver isMessage ifFalse: [ ^false ].
- receiver selector = #class ifFalse: [ ^false ].
-
+doImport: receiver selector: selector arguments: argumentNodes
+ | class namespace |
+ receiver isMessage ifTrue: [ ^false ].
class := self resolveClass: receiver.
- class instanceVariableNames: argumentNodes first value.
+ namespace := self resolveNamespace: argumentNodes first.
+ class import: namespace.
^false
!
--- orig/compiler/STLoaderObjs.st
+++ mod/compiler/STLoaderObjs.st
@@ -139,7 +139,7 @@ by an STClassLoader.'!
LoadedBehavior subclass: #LoadedClass
instanceVariableNames: 'name category sharedPools classVars class
- environment kind '
+ environment shape '
classVariableNames: ''
poolDictionaries: ''
category: 'System-Compiler'!
@@ -210,7 +210,7 @@ variableByteSubclass: s instanceVariable
classVariableNames: cvn
poolDictionaries: pd
category: c
- kind: 'variableByteSubclass:'
+ shape: #byte
loader: loader!
variableWordSubclass: s instanceVariableNames: ivn classVariableNames: cvn
@@ -223,7 +223,20 @@ variableWordSubclass: s instanceVariable
classVariableNames: cvn
poolDictionaries: pd
category: c
- kind: 'variableWordSubclass:'
+ shape: #word
+ loader: loader!
+
+variable: shape subclass: s instanceVariableNames: ivn classVariableNames: cvn
+ poolDictionaries: pd category: c
+
+ ^LoadedClass
+ superclass: self
+ name: s
+ instanceVariableNames: ivn
+ classVariableNames: cvn
+ poolDictionaries: pd
+ category: c
+ shape: shape
loader: loader!
variableSubclass: s instanceVariableNames: ivn classVariableNames: cvn
@@ -236,7 +249,7 @@ variableSubclass: s instanceVariableName
classVariableNames: cvn
poolDictionaries: pd
category: c
- kind: 'variableSubclass:'
+ shape: #pointer
loader: loader!
subclass: s instanceVariableNames: ivn classVariableNames: cvn
@@ -249,7 +262,19 @@ subclass: s instanceVariableNames: ivn c
classVariableNames: cvn
poolDictionaries: pd
category: c
- kind: 'subclass:'
+ shape: nil
+ loader: loader!
+
+subclass: s
+
+ ^LoadedClass
+ superclass: self
+ name: s
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: ''
+ shape: nil
loader: loader!
!PseudoBehavior methodsFor: 'method dictionary services'!
@@ -520,6 +545,14 @@ asMetaclass
self subclassResponsibility
!
+category
+ self subclassResponsibility
+!
+
+category: aString
+ self subclassResponsibility
+!
+
comment
self subclassResponsibility
!
@@ -528,6 +561,14 @@ comment: aString
self subclassResponsibility
!
+shape
+ self subclassResponsibility
+!
+
+shape: aSymbol
+ self subclassResponsibility
+!
+
environment
self subclassResponsibility
!
@@ -604,6 +645,14 @@ isClass
^true
!
+category
+ ^self asClass category
+!
+
+category: aString
+ ^self asClass category: aString
+!
+
comment
^self asClass comment
!
@@ -651,6 +700,10 @@ instVarNames
^instVars
!
+instanceVariableNames: ivn
+ instVars := (TokenStream on: ivn) contents.
+!
+
superclass
^superclass
!
@@ -674,10 +727,6 @@ isMetaclass
^true
!
-instanceVariableNames: ivn
- instVars := (TokenStream on: ivn) contents.
-!
-
asClass
^instanceClass
!
@@ -712,8 +761,8 @@ environment
^self asClass environment
!
-kindOfSubclass
- ^'subclass:'
+shape
+ ^nil
!
classVarNames
@@ -752,10 +801,10 @@ for: aClass
!LoadedClass class methodsFor: 'creating classes'!
superclass: sup name: s instanceVariableNames: ivn classVariableNames: cvn
- poolDictionaries: pd category: c kind: kind loader: loader
+ poolDictionaries: pd category: c shape: sh loader: loader
^self new
superclass: sup name: s instanceVariableNames: ivn classVariableNames:
cvn
- poolDictionaries: pd category: c kind: kind loader: loader
+ poolDictionaries: pd category: c shape: sh loader: loader
! !
!LoadedClass methodsFor: 'accessing'!
@@ -782,6 +831,21 @@ category
^category
!
+category: aString
+ "Set the class category"
+ category := aString
+!
+
+shape
+ "Answer the class shape"
+ ^shape
+!
+
+shape: aSymbol
+ "Set the class shape"
+ shape := aSymbol
+!
+
comment
"Answer the class comment"
^comment
@@ -798,8 +862,11 @@ environment
!
kindOfSubclass
- ^kind
-!
+ "Return a string indicating the type of class the receiver is"
+ self isVariable ifFalse: [ ^'subclass:' ].
+ self isPointers ifTrue: [ ^'variableSubclass:' ].
+ ^'variable: ', self shape storeString, 'subclass:'
+!
classVarNames
"Answer the names of the variables in the class pool dictionary"
@@ -811,6 +878,18 @@ sharedPools
"Return the names of the shared pools defined by the class"
^sharedPools
+!
+
+addClassVarName: aString
+ "Return the names of the shared pools defined by the class"
+
+ sharedPools := sharedPools copyWith: aString
+!
+
+import: aNamespace
+ "Return the names of the shared pools defined by the class"
+
+ sharedPools := sharedPools copyWith: (aNamespace nameIn: self environment)
! !
!LoadedClass methodsFor: 'filing'!
@@ -903,12 +982,12 @@ fileOutOn: aFileStream
!LoadedClass methodsFor: 'initializing'!
superclass: sup name: s instanceVariableNames: ivn classVariableNames: cvn
- poolDictionaries: pd category: c kind: k loader: loader
+ poolDictionaries: pd category: c shape: sh loader: loader
self initialize: loader.
superclass := sup.
name := s.
category := c.
- kind := k.
+ shape := sh.
environment := loader currentNamespace.
class := LoadedMetaclass new for: self.
instVars := (TokenStream on: ivn) contents.
--- orig/kernel/Behavior.st
+++ mod/kernel/Behavior.st
@@ -904,7 +904,7 @@ inheritsFrom: aClass
kindOfSubclass
"Return a string indicating the type of class the receiver is"
self isVariable ifFalse: [ ^'subclass:' ].
- self isPointers ifFalse: [ ^'variableSubclass:' ].
+ self isPointers ifTrue: [ ^'variableSubclass:' ].
^'variable: ', self shape storeString, 'subclass:'
!
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Help-smalltalk] update STClassLoader,
Paolo Bonzini <=