1"======================================================================
2|
3|   Smalltalk proxy class loader -- auxiliary classes
4|
5|
6 ======================================================================"
7
8
9"======================================================================
10|
11| Copyright 1999, 2000, 2001, 2002, 2007, 2008, 2009
12| Free Software Foundation, Inc.
13| Written by Paolo Bonzini.
14|
15| This file is part of GNU Smalltalk.
16|
17| GNU Smalltalk is free software; you can redistribute it and/or modify it
18| under the terms of the GNU General Public License as published by the Free
19| Software Foundation; either version 2, or (at your option) any later version.
20|
21| GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
22| ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
23| FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
24| details.
25|
26| You should have received a copy of the GNU General Public License along with
27| GNU Smalltalk; see the file COPYING.  If not, write to the Free Software
28| Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
29|
30 ======================================================================"
31
32STInST addSubspace: #STClassLoaderObjects!
33Namespace current: STClassLoaderObjects!
34
35Warning subclass: #UndefinedClassWarning
36        instanceVariableNames: 'undefinedClass'
37        classVariableNames: ''
38        poolDictionaries: ''
39        category: 'System-Compiler'!
40
41!UndefinedClassWarning class methodsFor: 'exception handling'!
42
43signal: anObject
44    ^self new
45        undefinedClass: anObject;
46        signal
47! !
48
49!UndefinedClassWarning methodsFor: 'exception handling'!
50
51description
52    ^'undefined class'
53!
54
55messageText
56    ^'undefined class %1' % {self undefinedClass name asString}
57!
58
59undefinedClass
60    ^undefinedClass
61!
62
63undefinedClass: anObject
64    undefinedClass := anObject
65! !
66
67
68Object subclass: #PseudoBehavior
69        instanceVariableNames: 'subclasses methods loader'
70        classVariableNames: ''
71        poolDictionaries: ''
72        category: 'System-Compiler'!
73
74PseudoBehavior comment:
75'This class represent a proxy for a class that is found by an
76STClassLoader in the source code it parses.'!
77
78Collection subclass: #OverlayDictionary
79           instanceVariableNames: 'primary secondary additionalSize'
80           classVariableNames: ''
81           poolDictionaries: ''
82           category: 'System-Compiler'!
83
84OverlayDictionary comment:
85'This class can access multiple Dictionaries and return keys from
86any of them'!
87
88!OverlayDictionary class methodsFor: 'instance creation'!
89
90on: backupDictionary
91    backupDictionary isNil ifTrue: [ ^LookupTable new ].
92    ^self new primary: LookupTable new; secondary: backupDictionary
93! !
94
95!OverlayDictionary methodsFor: 'accessing'!
96
97do: aBlock
98    primary do: aBlock.
99    secondary keysAndValuesDo: [ :k :v |
100        (primary includes: k) ifFalse: [ aBlock value: v ] ]!
101
102keysDo: aBlock
103    primary keysDo: aBlock.
104    secondary keysAndValuesDo: [ :k :v |
105        (primary includes: k) ifFalse: [ aBlock value: k ] ]!
106
107keysAndValuesDo: aBlock
108    primary keysAndValuesDo: aBlock.
109    secondary keysAndValuesDo: [ :k :v |
110        (primary includes: k) ifFalse: [ aBlock value: k value: v ] ]!
111
112keys
113    ^primary keys addAll: secondary keys; yourself!
114
115values
116    ^self asOrderedCollection!
117
118size
119    ^primary size + additionalSize!
120
121at: key
122    ^primary at: key ifAbsent: [ secondary at: key ]!
123
124at: key put: value
125    primary at: key ifAbsent: [
126        (secondary includesKey: key)
127	    ifTrue: [ additionalSize := additionalSize - 1 ] ].
128    ^primary at: key put: value!
129
130at: key ifAbsent: aBlock
131    ^primary at: key ifAbsent: [ secondary at: key ifAbsent: aBlock ]!
132
133at: key ifAbsentPut: aBlock
134    ^primary at: key ifAbsent: [
135        (secondary includesKey: key)
136	    ifTrue: [ secondary at: key ]
137	    ifFalse: [ primary at: key put: aBlock value ] ]! !
138
139
140
141!OverlayDictionary methodsFor: 'initializing'!
142
143primary: aDictionary
144    primary := aDictionary!
145
146secondary: aDictionary
147    secondary := aDictionary.
148    additionalSize := secondary size.
149! !
150
151
152PseudoBehavior subclass: #UndefinedClass
153        instanceVariableNames: 'name class environment'
154        classVariableNames: ''
155        poolDictionaries: ''
156        category: 'System-Compiler'!
157
158UndefinedClass comment:
159'This class represent a proxy for a class that is found by an
160STClassLoader while parsing source code, but is not
161the system.  It is possible to handle subclasses and extension methods
162of such classes.'!
163
164PseudoBehavior subclass: #UndefinedMetaclass
165        instanceVariableNames: 'instanceClass'
166        classVariableNames: ''
167        poolDictionaries: ''
168        category: 'System-Compiler'!
169
170UndefinedMetaclass comment:
171'This class represent a proxy for the metaclass of a class that is found
172by an STClassLoader while parsing source code, but is not the system.'!
173
174PseudoBehavior subclass: #ProxyClass
175        instanceVariableNames: 'proxy otherSide'
176        classVariableNames: ''
177        poolDictionaries: ''
178        category: 'System-Compiler'!
179
180ProxyClass comment:
181'This class represent a proxy for a preexisting class that is found by an
182STClassLoader as a superclass while parsing source code.  Proxying
183preexisting classes is necessary to correctly augment their subclasses
184with the new classes, and to handle extension methods.'!
185
186ProxyClass subclass: #ProxyNilClass
187        instanceVariableNames: ''
188        classVariableNames: ''
189        poolDictionaries: ''
190        category: 'System-Compiler'!
191
192ProxyClass comment:
193'This class represent a proxy for the nil fake superclass.'!
194
195PseudoBehavior subclass: #LoadedBehavior
196        instanceVariableNames: 'instVars superclass comment '
197        classVariableNames: ''
198        poolDictionaries: ''
199        category: 'System-Compiler'!
200
201LoadedBehavior comment:
202'This class represent a proxy for a class object that is defined
203by an STClassLoader.'!
204
205LoadedBehavior subclass: #LoadedClass
206        instanceVariableNames: 'name category sharedPools classVars class
207				environment shape declaration '
208        classVariableNames: ''
209        poolDictionaries: ''
210        category: 'System-Compiler'!
211
212LoadedClass comment:
213'This class represent a proxy for a class whose source code is parsed
214by an STClassLoader.'!
215
216LoadedBehavior subclass: #LoadedMetaclass
217        instanceVariableNames: 'instanceClass '
218        classVariableNames: ''
219        poolDictionaries: ''
220        category: 'System-Compiler'!
221
222LoadedMetaclass comment:
223'This class represent a proxy for a metaclass whose source code is parsed
224by an STClassLoader.'!
225
226Object subclass: #LoadedMethod
227        instanceVariableNames: 'node category isOldSyntax'
228        classVariableNames: ''
229        poolDictionaries: ''
230        category: 'System-Compiler'!
231
232LoadedMethod comment:
233'This class represent a proxy for a method, containing the source code
234that was parsed by an STClassLoader.'!
235
236BindingDictionary variableSubclass: #PseudoNamespace
237        instanceVariableNames: 'loader subspaces'
238        classVariableNames: ''
239        poolDictionaries: ''
240        category: 'System-Compiler'!
241
242PseudoNamespace comment:
243'This class represent a proxy for a namespace that an STClassLoader finds
244along the way.'!
245
246PseudoNamespace variableSubclass: #LoadedNamespace
247        instanceVariableNames: 'name'
248        classVariableNames: ''
249        poolDictionaries: ''
250        category: 'System-Compiler'!
251
252PseudoNamespace comment:
253'This class represent a proxy for a namespace that is created by the
254source code that an STClassLoader is parsing.'!
255
256PseudoNamespace variableSubclass: #ProxyNamespace
257        instanceVariableNames: 'proxy'
258        classVariableNames: ''
259        poolDictionaries: ''
260        category: 'System-Compiler'!
261
262ProxyNamespace comment:
263'This class represent a proxy for a preexisting namespace that is
264referenced by the source code that an STClassLoader is parsing.'!
265
266!PseudoBehavior class methodsFor: 'creating'!
267
268for: aSTClassLoader
269    ^self new initialize: aSTClassLoader
270! !
271
272!PseudoBehavior methodsFor: 'creating classes'!
273
274variableByteSubclass: s instanceVariableNames: ivn classVariableNames: cvn
275	poolDictionaries: pd category: c
276
277    ^LoadedClass
278	superclass: self
279	name: s
280	instanceVariableNames: ivn
281	classVariableNames: cvn
282	poolDictionaries: pd
283	category: c
284	shape: #byte
285	loader: loader!
286
287variableWordSubclass: s instanceVariableNames: ivn classVariableNames: cvn
288	poolDictionaries: pd category: c
289
290    ^LoadedClass
291	superclass: self
292	name: s
293	instanceVariableNames: ivn
294	classVariableNames: cvn
295	poolDictionaries: pd
296	category: c
297	shape: #word
298	loader: loader!
299
300variable: shape subclass: s instanceVariableNames: ivn classVariableNames: cvn
301	poolDictionaries: pd category: c
302
303    ^LoadedClass
304	superclass: self
305	name: s
306	instanceVariableNames: ivn
307	classVariableNames: cvn
308	poolDictionaries: pd
309	category: c
310	shape: shape
311	loader: loader!
312
313variableSubclass: s instanceVariableNames: ivn classVariableNames: cvn
314	poolDictionaries: pd category: c
315
316    ^LoadedClass
317	superclass: self
318	name: s
319	instanceVariableNames: ivn
320	classVariableNames: cvn
321	poolDictionaries: pd
322	category: c
323	shape: #pointer
324	loader: loader!
325
326subclass: s instanceVariableNames: ivn classVariableNames: cvn
327	poolDictionaries: pd category: c
328
329    ^LoadedClass
330	superclass: self
331	name: s
332	instanceVariableNames: ivn
333	classVariableNames: cvn
334	poolDictionaries: pd
335	category: c
336	shape: nil
337	loader: loader!
338
339subclass: s declaration: cstructDecl classVariableNames: cvn
340	poolDictionaries: pd category: c
341
342    ^(self
343	subclass: s
344	instanceVariableNames: ''
345	classVariableNames: cvn
346	poolDictionaries: pd
347	category: c) declaration: cstructDecl; yourself!
348
349variableByteSubclass: s instanceVariableNames: ivn classVariableNames: cvn
350	poolDictionaries: pd
351
352    ^LoadedClass
353	superclass: self
354	name: s
355	instanceVariableNames: ivn
356	classVariableNames: cvn
357	poolDictionaries: pd
358	category: ''
359	shape: #byte
360	loader: loader!
361
362variableWordSubclass: s instanceVariableNames: ivn classVariableNames: cvn
363	poolDictionaries: pd
364
365    ^LoadedClass
366	superclass: self
367	name: s
368	instanceVariableNames: ivn
369	classVariableNames: cvn
370	poolDictionaries: pd
371	category: ''
372	shape: #word
373	loader: loader!
374
375variable: shape subclass: s instanceVariableNames: ivn classVariableNames: cvn
376	poolDictionaries: pd
377
378    ^LoadedClass
379	superclass: self
380	name: s
381	instanceVariableNames: ivn
382	classVariableNames: cvn
383	poolDictionaries: pd
384	category: ''
385	shape: shape
386	loader: loader!
387
388variableSubclass: s instanceVariableNames: ivn classVariableNames: cvn
389	poolDictionaries: pd
390
391    ^LoadedClass
392	superclass: self
393	name: s
394	instanceVariableNames: ivn
395	classVariableNames: cvn
396	poolDictionaries: pd
397	category: ''
398	shape: #pointer
399	loader: loader!
400
401subclass: s instanceVariableNames: ivn classVariableNames: cvn
402	poolDictionaries: pd
403
404    ^LoadedClass
405	superclass: self
406	name: s
407	instanceVariableNames: ivn
408	classVariableNames: cvn
409	poolDictionaries: pd
410	category: ''
411	shape: nil
412	loader: loader!
413
414subclass: s
415
416    ^LoadedClass
417	superclass: self
418	name: s
419	instanceVariableNames: ''
420	classVariableNames: ''
421	poolDictionaries: ''
422	category: ''
423	shape: nil
424	loader: loader!
425
426!PseudoBehavior methodsFor: 'method dictionary services'!
427
428selectors
429    "Answer a Set of the receiver's selectors"
430    ^self methodDictionary keys
431!
432
433allSelectors
434    "Answer a Set of all the selectors understood by the receiver"
435    | aSet |
436    aSet := self selectors.
437    self allSuperclassesDo:
438        [ :superclass | aSet addAll: superclass selectors ].
439    ^aSet
440!
441
442compiledMethodAt: selector
443    "Return the compiled method associated with selector, from the local
444    method dictionary.  Error if not found."
445    ^self methodDictionary at: selector
446!
447
448includesSelector: selector
449    "Return whether there is a compiled method associated with
450    selector, from the local method dictionary."
451    ^self methodDictionary includesKey: selector
452!
453
454parseNodeAt: selector
455    "Answer the parse tree (if available) for the given selector"
456    ^(self >> selector) methodParseNode
457!
458
459sourceCodeAt: selector
460    "Answer source code (if available) for the given selector"
461    | source |
462    source := (self >> selector) methodSourceCode.
463    source isNil ifTrue: [ '" *** SOURCE CODE NOT AVAILABLE *** "' copy ].
464    ^source asString
465!
466
467>> selector
468    "Return the compiled method associated with selector, from the local
469    method dictionary.  Error if not found."
470    ^self methodDictionary at: selector
471! !
472
473
474!PseudoBehavior methodsFor: 'navigating hierarchy'!
475
476subclasses
477    subclasses isNil
478        ifTrue: [ subclasses := OrderedCollection new ].
479    ^subclasses
480!
481
482addSubclass: aClass
483    "Add aClass asone of the receiver's subclasses."
484    self subclasses remove: aClass ifAbsent: [].
485    self subclasses add: aClass
486!
487
488removeSubclass: aClass
489    "Remove aClass from the list of the receiver's subclasses"
490    self subclasses remove: aClass ifAbsent: [].
491!
492
493allSubclassesDo: aBlock
494    "Invokes aBlock for all subclasses, both direct and indirect."
495    self subclasses do: [ :class |
496        aBlock value: class.
497        class allSubclassesDo: aBlock
498    ].
499!
500
501allSuperclassesDo: aBlock
502    "Invokes aBlock for all superclasses, both direct and indirect."
503    | class superclass |
504    class := self.
505    [ superclass := class superclass.
506      class := superclass.
507      superclass notNil ] whileTrue:
508        [ aBlock value: superclass ]
509!
510
511withAllSubclassesDo: aBlock
512    "Invokes aBlock for the receiver and all subclasses, both direct
513     and indirect."
514    aBlock value: self.
515    self allSubclassesDo: aBlock.
516!
517
518withAllSuperclassesDo: aBlock
519    "Invokes aBlock for the receiver and all superclasses, both direct
520     and indirect."
521    | class |
522    class := self.
523    [ aBlock value: class.
524      class := class superclass.
525      class notNil ] whileTrue
526!
527
528selectSubclasses: aBlock
529    "Return a Set of subclasses of the receiver satisfying aBlock."
530    | aSet |
531    aSet := Set new.
532    self allSubclassesDo: [ :subclass | (aBlock value: subclass)
533                                            ifTrue: [ aSet add: subclass ] ].
534    ^aSet
535!
536
537selectSuperclasses: aBlock
538    "Return a Set of superclasses of the receiver satisfying aBlock."
539    | aSet |
540    aSet := Set new.
541    self allSuperclassesDo: [ :superclass | (aBlock value: superclass)
542                                            ifTrue: [ aSet add: superclass ] ].
543    ^aSet
544!
545
546subclassesDo: aBlock
547    "Invokes aBlock for all direct subclasses."
548    self subclasses do: aBlock
549! !
550
551!PseudoBehavior methodsFor: 'accessing'!
552
553loader
554    ^loader
555!
556
557allInstVarNames
558    "Answer the names of the variables in the receiver's inst pool dictionary
559     and in each of the superinstes' inst pool dictionaries"
560
561    ^self superclass allInstVarNames, self instVarNames
562!
563
564allClassVarNames
565    "Answer the names of the variables in the receiver's class pool dictionary
566     and in each of the superclasses' class pool dictionaries"
567
568    ^self asClass allClassVarNames
569!
570
571allSharedPools
572    "Return the names of the shared pools defined by the class and any of
573     its superclasses"
574
575    ^self asClass allSharedPools
576!
577
578nameIn: aNamespace
579    "Answer the class name when the class is referenced from aNamespace"
580    | proxy reference |
581    proxy := loader proxyForNamespace: aNamespace.
582    reference := proxy at: self name asSymbol ifAbsent: [ nil ].
583    self = reference ifTrue: [ ^self name asString ].
584    ^(self environment nameIn: aNamespace), '.', self printString
585! !
586
587
588!PseudoBehavior methodsFor: 'testing'!
589
590isDefined
591    ^true
592!
593
594isFullyDefined
595    self isDefined ifFalse: [ ^false ].
596    ^self superclass isNil or: [ self superclass isFullyDefined ]
597! !
598
599
600!PseudoBehavior methodsFor: 'abstract'!
601
602classPragmas
603    self subclassResponsibility
604!
605
606asClass
607    self subclassResponsibility
608!
609
610asMetaclass
611    self subclassResponsibility
612!
613
614category
615    ^nil
616!
617
618comment
619    self subclassResponsibility
620!
621
622kindOfSubclass
623    "Return a string indicating the type of class the receiver is"
624
625    self shape isNil ifFalse: [^'subclass:'].
626    self shape == #pointer ifTrue: [^'variableSubclass:'].
627    self shape == #byte ifTrue: [^'variableByteSubclass:'].
628    self shape == (CLongSize == 4 ifTrue: [ #uint32 ] ifFalse: [ #uint64 ])
629	ifTrue: [^'variableWordSubclass:'].
630    ^'variable: ' , self shape storeString , 'subclass:'
631!
632
633inheritShape
634    ^false
635!
636
637shape
638    ^nil
639!
640
641environment
642    self subclassResponsibility
643!
644
645kindOfSubclass
646    "Return a string indicating the type of class the receiver is"
647    self shape isNil ifTrue: [ ^'subclass:' ].
648    self shape == #pointer ifTrue: [ ^'variableSubclass:' ].
649    ^'variable: ', self shape storeString, 'subclass:'
650!
651
652inheritShape
653    ^false
654!
655
656sharedPools
657    self subclassResponsibility
658!
659
660superclass
661    self subclassResponsibility
662!
663
664methodDictionary
665    methods isNil ifTrue: [ methods := LookupTable new ].
666    ^methods
667!
668
669methodDictionary: aDictionary
670    methods := aDictionary
671!
672
673collectCategories
674    | categories |
675    self methodDictionary isNil ifTrue: [ ^#() ].
676
677    categories := Set new.
678    self methodDictionary do:
679	[ :method | categories add: (method methodCategory) ].
680
681    ^categories asSortedCollection
682! !
683
684!PseudoBehavior methodsFor: 'printing'!
685
686printOn: aStream
687    aStream
688	nextPutAll: self name!
689! !
690
691!PseudoBehavior methodsFor: 'storing'!
692
693storeOn: aStream
694    aStream
695	nextPutAll: self name!
696! !
697
698!PseudoBehavior methodsFor: 'initializing'!
699
700initialize: aSTClassLoader
701    loader := aSTClassLoader
702! !
703
704!ProxyClass class methodsFor: 'creating classes'!
705
706on: aClass for: aSTClassLoader
707    ^(self for: aSTClassLoader) setProxy: aClass
708! !
709
710!ProxyClass methodsFor: 'testing'!
711
712isDefined
713     ^true
714!
715
716isFullyDefined
717     ^true
718! !
719
720!ProxyClass methodsFor: 'delegation'!
721
722= anObject
723    ^proxy == anObject
724	or: [ anObject class == self class
725		 and: [ proxy == anObject proxy ] ]
726!
727
728hash
729    ^proxy hash
730!
731
732proxy
733   ^proxy
734!
735
736classPragmas
737    ^proxy classPragmas
738!
739
740printOn: aStream
741    proxy printOn: aStream
742!
743
744asClass
745    proxy isClass ifTrue: [ ^self ].
746    otherSide isNil
747	ifTrue: [ otherSide := ProxyClass on: proxy instanceClass for: self loader ].
748    ^otherSide
749!
750
751asMetaclass
752    proxy isMetaclass ifTrue: [ ^self ].
753    otherSide isNil
754	ifTrue: [ otherSide := ProxyClass on: proxy class for: self loader ].
755    ^otherSide
756!
757
758isClass
759    ^proxy isClass
760!
761
762isMetaclass
763    ^proxy isMetaclass
764!
765
766category
767    ^proxy category
768!
769
770comment
771    ^proxy comment
772!
773
774environment
775    ^proxy environment
776!
777
778inheritShape
779    ^proxy inheritShape
780!
781
782shape
783    ^proxy shape
784!
785
786superclass
787    ^proxy superclass
788!
789
790doesNotUnderstand: aMessage
791    ^proxy perform: aMessage
792! !
793
794
795!ProxyClass methodsFor: 'initializing'!
796
797setProxy: aClass
798    proxy := aClass.
799    self methodDictionary: (OverlayDictionary on: proxy methodDictionary)
800! !
801
802!ProxyNilClass methodsFor: 'accessing'!
803
804classPragmas
805    ^#(#comment #category)
806!
807
808nameIn: aNamespace
809    ^'nil'
810! !
811
812!UndefinedClass class methodsFor: 'creating'!
813
814name: aSymbol in: aNamespace for: aLoader
815    ^(self for: aLoader)
816	environment: aNamespace;
817	name: aSymbol
818! !
819
820!UndefinedClass methodsFor: 'testing'!
821
822isDefined
823    ^false
824! !
825
826!UndefinedClass methodsFor: 'accessing'!
827
828asMetaclass
829    ^class!
830
831asClass
832    ^self!
833
834classPragmas
835    ^#(#comment #category)
836!
837
838name
839    ^name
840!
841
842name: aSymbol
843    name := aSymbol
844!
845
846initialize: aSTLoader
847    super initialize: aSTLoader.
848    class := UndefinedMetaclass for: self
849!
850
851environment
852    ^environment
853!
854
855environment: aNamespace
856    environment := aNamespace.
857!
858
859superclass
860    UndefinedClassWarning signal: self.
861    ^nil
862! !
863
864!UndefinedClass methodsFor: 'printing'!
865
866printOn: aStream
867    aStream nextPutAll: self name!
868! !
869
870!UndefinedMetaclass class methodsFor: 'creating'!
871
872for: aClass
873    ^(super for: aClass loader)
874	initializeFor: aClass! !
875
876!UndefinedMetaclass methodsFor: 'printing'!
877
878printOn: aStream
879    aStream
880	nextPutAll: self asClass name;
881	nextPutAll: ' class'!
882! !
883
884!UndefinedMetaclass methodsFor: 'initializing'!
885
886initializeFor: aClass
887    super initialize: aClass loader.
888    instanceClass := aClass! !
889
890!UndefinedMetaclass methodsFor: 'accessing'!
891
892isClass
893    ^false
894!
895
896isMetaclass
897    ^true
898!
899
900asClass
901    ^instanceClass
902!
903
904asMetaclass
905    ^self
906! !
907
908!UndefinedMetaclass methodsFor: 'delegation'!
909
910name
911    ^self asClass name
912!
913
914category
915    "Answer the class category"
916    ^self asClass category
917!
918
919comment
920    "Answer the class comment"
921    ^self asClass comment
922!
923
924comment: aString
925    "Answer the class comment"
926    ^self asClass comment: aString
927!
928
929environment
930    "Answer the namespace in which the receiver is implemented"
931    ^self asClass environment
932!
933
934classVarNames
935    "Answer the names of the variables in the class pool dictionary"
936
937    ^self asClass classVarNames
938!
939
940sharedPools
941    "Return the names of the shared pools defined by the class"
942
943    ^self asClass sharedPools
944! !
945
946!UndefinedMetaclass methodsFor: 'testing'!
947
948isDefined
949    ^false
950! !
951
952!UndefinedMetaclass methodsFor: 'delegation'!
953
954name
955    ^self asClass name
956! !
957
958
959
960!LoadedMetaclass class methodsFor: 'creating'!
961
962for: aClass
963    ^(super for: aClass loader)
964	initializeFor: aClass! !
965
966!LoadedBehavior methodsFor: 'accessing'!
967
968instVarNames
969    "Answer the names of the variables in the inst pool dictionary"
970
971    ^instVars
972!
973
974instanceVariableNames: ivn
975    instVars := ivn subStrings.
976!
977
978superclass
979    ^superclass
980!
981
982article
983    ^superclass article
984! !
985
986!LoadedMetaclass methodsFor: 'printing'!
987
988printOn: aStream
989    aStream
990	nextPutAll: self asClass name;
991	nextPutAll: ' class'!
992! !
993
994!LoadedMetaclass methodsFor: 'accessing'!
995
996isClass
997    ^false
998!
999
1000isMetaclass
1001    ^true
1002!
1003
1004asClass
1005    ^instanceClass
1006!
1007
1008asMetaclass
1009    ^self
1010! !
1011
1012!LoadedMetaclass methodsFor: 'delegation'!
1013
1014name
1015    ^self asClass name
1016!
1017
1018category
1019    "Answer the class category"
1020    ^self asClass category
1021!
1022
1023comment
1024    "Answer the class comment"
1025    ^self asClass comment
1026!
1027
1028comment: aString
1029    "Answer the class comment"
1030    ^self asClass comment: aString
1031!
1032
1033environment
1034    "Answer the namespace in which the receiver is implemented"
1035    ^self asClass environment
1036!
1037
1038classVarNames
1039    "Answer the names of the variables in the class pool dictionary"
1040
1041    ^self asClass classVarNames
1042!
1043
1044sharedPools
1045    "Return the names of the shared pools defined by the class"
1046
1047    ^self asClass sharedPools
1048! !
1049
1050
1051
1052!LoadedMetaclass class methodsFor: 'creating'!
1053
1054for: aClass
1055    ^(super for: aClass loader)
1056	initializeFor: aClass! !
1057
1058!LoadedMetaclass methodsFor: 'initializing'!
1059
1060initializeFor: aClass
1061    super initialize: aClass loader.
1062    instanceClass := aClass.
1063    instVars := Array new.
1064    superclass := aClass superclass class.
1065    superclass addSubclass: self
1066!
1067
1068!LoadedClass class methodsFor: 'creating classes'!
1069
1070superclass: sup name: s instanceVariableNames: ivn classVariableNames: cvn
1071	poolDictionaries: pd category: c shape: sh loader: loader
1072    ^(self for: loader)
1073	superclass: sup name: s instanceVariableNames: ivn classVariableNames: cvn
1074	poolDictionaries: pd category: c shape: sh
1075! !
1076
1077!LoadedClass methodsFor: 'accessing'!
1078
1079isClass
1080    ^true
1081!
1082
1083isMetaclass
1084    ^false
1085!
1086
1087asClass
1088    ^self
1089!
1090
1091asMetaclass
1092    ^class
1093!
1094
1095name
1096    "Answer the class name"
1097    ^name
1098!
1099
1100category
1101    "Answer the class category"
1102    ^category
1103!
1104
1105category: aString
1106    "Set the class category"
1107    category := aString
1108!
1109
1110classPragmas
1111    ^superclass classPragmas
1112!
1113
1114declaration
1115    "Answer the class declaration for CStruct subclasses"
1116    ^declaration
1117!
1118
1119declaration: aString
1120    "Set the class declaration (for CStruct subclasses)"
1121    declaration := aString
1122!
1123
1124shape
1125    "Answer the class shape"
1126    ^shape
1127!
1128
1129shape: aSymbol
1130    "Set the class shape"
1131    shape := aSymbol
1132!
1133
1134comment
1135    "Answer the class comment"
1136    ^comment
1137!
1138
1139comment: aString
1140    "Set the class comment"
1141    comment := aString
1142!
1143
1144environment
1145    "Answer the namespace in which the receiver is implemented"
1146    ^environment
1147!
1148
1149classVarNames
1150    "Answer the names of the variables in the class pool dictionary"
1151
1152    ^classVars
1153!
1154
1155sharedPools
1156    "Return the names of the shared pools defined by the class"
1157
1158    ^sharedPools
1159!
1160
1161addClassVarName: aString
1162    "Return the names of the shared pools defined by the class"
1163
1164    classVars := classVars copyWith: aString
1165!
1166
1167addClassVarName: aString value: aBlock
1168    "Return the names of the shared pools defined by the class"
1169
1170    classVars := classVars copyWith: aString
1171!
1172
1173import: aNamespace
1174    "Return the names of the shared pools defined by the class"
1175
1176    sharedPools := sharedPools copyWith: (aNamespace nameIn: self environment)
1177! !
1178
1179
1180!LoadedClass methodsFor: 'initializing'!
1181
1182superclass: sup name: s instanceVariableNames: ivn classVariableNames: cvn
1183	poolDictionaries: pd category: c shape: sh
1184    superclass := sup.
1185    name := s.
1186    category := c.
1187    shape := sh.
1188    environment := loader currentNamespace.
1189    class := LoadedMetaclass for: self.
1190    instVars := ivn subStrings.
1191    classVars := cvn subStrings.
1192    sharedPools := pd subStrings.
1193    superclass addSubclass: self.
1194    environment at: name put: self.
1195! !
1196
1197!LoadedMethod class methodsFor: 'instance creation'!
1198
1199node: aRBMethodNode
1200    ^self new
1201	    node: aRBMethodNode
1202!
1203
1204!LoadedMethod methodsFor: 'accessing'!
1205
1206node
1207    ^node
1208!
1209
1210node: aRBMethodNode
1211    node := aRBMethodNode.
1212    category := node category.
1213    category isNil ifTrue: [ self extractMethodCategory ]
1214!
1215
1216extractMethodCategory
1217    node primitiveSources do: [:each |
1218	self extractMethodCategory: (RBScanner on: each readStream).
1219	category isNil ifFalse: [ ^self ] ]
1220!
1221
1222extractMethodCategory: scanner
1223    | currentToken argument |
1224    currentToken := scanner next.
1225    (currentToken isBinary and: [currentToken value == #<]) ifFalse: [^self].
1226    currentToken := scanner next.
1227    currentToken isKeyword ifFalse: [^self].
1228    currentToken value = 'category:' ifFalse: [^self].
1229    currentToken := scanner next.
1230    currentToken isLiteral ifFalse: [^self].
1231    argument := currentToken value.
1232    currentToken := scanner next.
1233    (currentToken isBinary and: [currentToken value == #>]) ifFalse: [^self].
1234    category := argument.
1235!
1236
1237methodFormattedSourceString
1238    "Answer the method source code as a string, formatted using
1239     the RBFormatter."
1240
1241    <category: 'compiling'>
1242    ^STInST.RBFormatter new
1243                  initialIndent: 1;
1244                  format: self methodParseNode
1245!
1246
1247methodParseNode
1248    ^self node
1249!
1250
1251methodCategory
1252    ^category
1253!
1254
1255methodSourceCode
1256    ^node source asSourceCode
1257!
1258
1259selector
1260    ^node selector asSymbol
1261!
1262
1263methodSourceString
1264    ^node source asString
1265!
1266
1267isOldSyntax
1268    ^isOldSyntax ifNil: [false]
1269!
1270
1271noteOldSyntax
1272    isOldSyntax := true.
1273! !
1274
1275!LoadedMethod methodsFor: 'empty stubs'!
1276
1277discardTranslation
1278    "Do nothing"
1279! !
1280
1281!PseudoNamespace methodsFor: 'abstract'!
1282
1283name
1284    self subclassResponsibility! !
1285
1286!PseudoNamespace methodsFor: 'printing'!
1287
1288nameIn: aNamespace
1289    "Answer Smalltalk code compiling to the receiver when the current
1290     namespace is aNamespace"
1291
1292    | reference proxy |
1293    proxy := loader proxyForNamespace: aNamespace.
1294    reference := proxy at: self name asSymbol ifAbsent: [ nil ].
1295    self = reference ifTrue: [ ^self name asString ].
1296    ^(self superspace nameIn: aNamespace ), '.', self name
1297!
1298
1299printOn: aStream
1300    aStream nextPutAll: (self nameIn: Namespace current)
1301! !
1302
1303!PseudoNamespace methodsFor: 'storing'!
1304
1305storeOn: aStream
1306    aStream nextPutAll: (self nameIn: Namespace current)
1307! !
1308
1309!PseudoNamespace methodsFor: 'initializing'!
1310
1311copyEmpty: newSize
1312    ^(super copyEmpty: newSize)
1313	setLoader: loader;
1314	setSubspaces: subspaces;
1315	yourself
1316!
1317
1318setLoader: aSTClassLoader
1319    loader := aSTClassLoader
1320!
1321
1322setSubspaces: aSet
1323    subspaces := aSet
1324! !
1325
1326!PseudoNamespace methodsFor: 'accessing'!
1327
1328superspace
1329    ^self environment
1330!
1331
1332setSuperspace: superspace
1333    self environment: superspace.
1334    self environment subspaces add: self
1335!
1336
1337subspaces
1338    subspaces isNil ifTrue: [ subspaces := IdentitySet new ].
1339    ^subspaces
1340!
1341
1342addSubspace: aSymbol
1343    ^LoadedNamespace name: aSymbol in: self for: loader
1344! !
1345
1346!LoadedNamespace class methodsFor: 'instance creation'!
1347
1348name: aSymbol in: aDictionary for: aSTClassLoader
1349    ^aDictionary at: aSymbol put: (self new
1350	name: aSymbol;
1351	setLoader: aSTClassLoader;
1352	environment: aDictionary;
1353	yourself)
1354! !
1355
1356!LoadedNamespace methodsFor: 'initializing'!
1357copyEmpty: newSize
1358    ^(super copyEmpty: newSize)
1359        name: name;
1360    	yourself
1361! !
1362
1363!LoadedNamespace methodsFor: 'accessing'!
1364
1365at: key ifAbsent: aBlock
1366    "Return the value associated to the variable named as specified
1367    by `key'. If the key is not found search will be brought on in
1368    superspaces, finally evaluating aBlock if the variable cannot be
1369    found in any of the superspaces."
1370    | index space |
1371    space := self.
1372    [
1373	space at: key ifPresent: [ :value | ^value ].
1374	space := space superspace.
1375	space isNil
1376    ] whileFalse.
1377    ^aBlock value
1378!
1379
1380name
1381    ^name
1382!
1383
1384name: aSymbol
1385    name := aSymbol
1386! !
1387
1388!LoadedNamespace methodsFor: 'printing'!
1389
1390printOn: aStream
1391    aStream
1392	nextPutAll: 'LoadedNamespace[';
1393	nextPutAll: self name;
1394	nextPut: $]! !
1395
1396
1397!ProxyNamespace class methodsFor: 'accessing'!
1398
1399on: aDictionary for: aSTClassLoader
1400    | instance superspace subspaceProxy |
1401    instance := self new
1402	setLoader: aSTClassLoader;
1403	setProxy: aDictionary;
1404	yourself.
1405
1406    "Link the instance to itself."
1407    instance
1408	at: aDictionary name asSymbol put: instance.
1409
1410    "Create proxies for the superspaces and for links to the
1411     subspaces"
1412    aDictionary superspace isNil ifFalse: [
1413	superspace := aDictionary superspace.
1414	instance
1415	    setSuperspace: (aSTClassLoader proxyForNamespace: superspace).
1416
1417	subspaceProxy := instance.
1418	[ superspace isNil ] whileFalse: [
1419	    superspace := aSTClassLoader proxyForNamespace: superspace.
1420	    superspace
1421		at: subspaceProxy name asSymbol put: subspaceProxy.
1422	    instance
1423		at: superspace name asSymbol put: superspace.
1424	    subspaceProxy := superspace.
1425	    superspace := superspace superspace
1426	].
1427    ].
1428
1429    ^instance
1430! !
1431
1432!ProxyNamespace methodsFor: 'initializing'!
1433
1434copyEmpty: newSize
1435    ^(super copyEmpty: newSize)
1436	setProxy: proxy;
1437	yourself
1438!
1439
1440setProxy: aDictionary
1441    proxy := aDictionary!
1442! !
1443
1444!ProxyNamespace methodsFor: 'accessing'!
1445
1446= anObject
1447    ^anObject == self proxy or: [
1448	anObject class == self class and: [
1449	    self proxy == anObject proxy ]]
1450!
1451
1452hash
1453    ^proxy hash
1454!
1455
1456proxy
1457    ^proxy
1458!
1459
1460at: aKey
1461    ^super at: aKey ifAbsent: [
1462	proxy at: aKey ]!
1463
1464at: aKey ifAbsent: aBlock
1465    ^super at: aKey ifAbsent: [
1466	proxy at: aKey ifAbsent: aBlock ]!
1467
1468at: aKey ifAbsentPut: aBlock
1469    ^super at: aKey ifAbsent: [
1470	proxy at: aKey ifAbsent: [
1471	    self at: aKey put: aBlock value ]]!
1472
1473at: aKey ifPresent: aBlock
1474    | result |
1475    result := super at: aKey ifAbsent: [
1476	proxy at: aKey ifAbsent: [ ^nil ] ].
1477    ^aBlock value: result!
1478
1479name
1480    "Answer the receiver's name"
1481    ^proxy name
1482!
1483
1484printOn: aStream
1485    "Print a representation of the receiver on aStream"
1486    aStream nextPutAll: self classNameString , '[', proxy name, '] (' ; nl.
1487    self myKeysAndValuesDo:
1488    	[ :key :value | aStream tab;
1489		   print: key;
1490		   nextPutAll: '->';
1491		   print: value;
1492		   nl ].
1493    aStream nextPut: $)
1494!
1495
1496do: aBlock
1497    super do: aBlock.
1498    proxy do: aBlock!
1499
1500keysAndValuesDo: aBlock
1501    super keysAndValuesDo: aBlock.
1502    proxy keysAndValuesDo: aBlock!
1503
1504myKeysAndValuesDo: aBlock
1505    super keysAndValuesDo: aBlock!
1506
1507associationsDo: aBlock
1508    super associationsDo: aBlock.
1509    proxy associationsDo: aBlock!
1510
1511keysDo: aBlock
1512    super keysDo: aBlock.
1513    proxy keysDo: aBlock!
1514
1515includesKey: aKey
1516    ^(super includesKey: aKey) or: [
1517	proxy includesKey: aKey ]! !
1518
1519Namespace current: STInST!
1520