/
SpurBootstrapSqueakFamilyPrototypes.class.st
172 lines (160 loc) · 7.88 KB
/
SpurBootstrapSqueakFamilyPrototypes.class.st
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
Class {
#name : #SpurBootstrapSqueakFamilyPrototypes,
#superclass : #SpurBootstrapPrototypes,
#category : #'CogAttic-Bootstrapping'
}
{ #category : #accessing }
SpurBootstrapSqueakFamilyPrototypes class >> imageType [
^'squeak'
]
{ #category : #'method prototypes' }
SpurBootstrapSqueakFamilyPrototypes >> ClassBuilderPROTOTYPEcomputeFormat: type instSize: newInstSize forSuper: newSuper ccIndex: ccIndex [
"Compute the new format for making oldClass a subclass of newSuper.
Answer the format or nil if there is any problem."
| instSize isVar isWords isPointers isWeak |
type == #compiledMethod ifTrue:
[newInstSize > 0 ifTrue:
[self error: 'A compiled method class cannot have named instance variables'.
^nil].
^CompiledMethod format].
instSize := newInstSize + (newSuper ifNil:[0] ifNotNil:[newSuper instSize]).
instSize > 65535 ifTrue:
[self error: 'Class has too many instance variables (', instSize printString,')'.
^nil].
type == #normal ifTrue:[isVar := isWeak := false. isWords := isPointers := true].
type == #bytes ifTrue:[isVar := true. isWords := isPointers := isWeak := false].
type == #words ifTrue:[isVar := isWords := true. isPointers := isWeak := false].
type == #variable ifTrue:[isVar := isPointers := isWords := true. isWeak := false].
type == #weak ifTrue:[isVar := isWeak := isWords := isPointers := true].
type == #ephemeron ifTrue:[isVar := false. isWeak := isWords := isPointers := true].
type == #immediate ifTrue:[isVar := isWeak := isPointers := false. isWords := true].
(isPointers not and: [instSize > 0]) ifTrue:
[self error: 'A non-pointer class cannot have named instance variables'.
^nil].
^self format: instSize variable: isVar words: isWords pointers: isPointers weak: isWeak
]
{ #category : #'method prototypes' }
SpurBootstrapSqueakFamilyPrototypes >> ClassBuilderPROTOTYPEformat: nInstVars variable: isVar words: is32BitWords pointers: isPointers weak: isWeak [
"Compute the format for the given instance specfication.
Above Cog Spur the class format is
<5 bits inst spec><16 bits inst size>
where the 5-bit inst spec is
0 = 0 sized objects (UndefinedObject True False et al)
1 = non-indexable objects with inst vars (Point et al)
2 = indexable objects with no inst vars (Array et al)
3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
4 = weak indexable objects with inst vars (WeakArray et al)
5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
6 = unused
7 = immediates (SmallInteger, Character)
8 = unused
9 = reserved for 64-bit indexable
10-11 = 32-bit indexable (Bitmap)
12-15 = 16-bit indexable
16-23 = 8-bit indexable
24-31 = compiled methods (CompiledMethod)"
| instSpec |
instSpec := isWeak
ifTrue:
[isVar
ifTrue: [4]
ifFalse: [5]]
ifFalse:
[isPointers
ifTrue:
[isVar
ifTrue: [nInstVars > 0 ifTrue: [3] ifFalse: [2]]
ifFalse: [nInstVars > 0 ifTrue: [1] ifFalse: [0]]]
ifFalse:
[isVar
ifTrue: [is32BitWords ifTrue: [10] ifFalse: [16]]
ifFalse: [7]]].
^(instSpec bitShift: 16) + nInstVars
]
{ #category : #'method prototypes' }
SpurBootstrapSqueakFamilyPrototypes >> ClassBuilderPROTOTYPEsuperclass: aClass
immediateSubclass: t instanceVariableNames: f
classVariableNames: d poolDictionaries: s category: cat [
"This is the standard initialization message for creating a
new immediate class as a subclass of an existing class."
| env |
aClass instSize > 0
ifTrue: [^self error: 'cannot make an immediate subclass of a class with named fields'].
aClass isVariable
ifTrue: [^self error: 'cannot make an immediate subclass of a class with indexed instance variables'].
aClass isPointers
ifFalse: [^self error: 'cannot make an immediate subclass of a class without pointer fields'].
"Cope with pre-environment and environment versions. Simplify asap."
env := (Smalltalk classNamed: #EnvironmentRequest)
ifNil: [aClass environment]
ifNotNil: [:erc| erc signal ifNil: [aClass environment]].
^self
name: t
inEnvironment: env
subclassOf: aClass
type: #immediate
instanceVariableNames: f
classVariableNames: d
poolDictionaries: s
category: cat
]
{ #category : #'method prototypes' }
SpurBootstrapSqueakFamilyPrototypes >> ClassBuilderPROTOTYPEupdate: oldClass to: newClass [
"Convert oldClass, all its instances and possibly its meta class into newClass,
instances of newClass and possibly its meta class. The process is surprisingly
simple in its implementation and surprisingly complex in its nuances and potentially
bad side effects.
We can rely on two assumptions (which are critical):
#1: The method #updateInstancesFrom: will not create any lasting pointers to
'old' instances ('old' is quote on quote since #updateInstancesFrom: will do
a become of the old vs. the new instances and therefore it will not create
pointers to *new* instances before the #become: which are *old* afterwards)
#2: The non-preemptive execution of the critical piece of code guarantees that
nobody can get a hold by 'other means' (such as process interruption and
reflection) on the old instances.
Given the above two, we know that after #updateInstancesFrom: there are no pointers
to any old instances. After the forwarding become there will be no pointers to the old
class or meta class either.
Andreas Raab, 2/27/2003 23:42"
| meta |
meta := oldClass isMeta.
"Note: Everything from here on will run without the ability to get interrupted
to prevent any other process to create new instances of the old class."
["Note: The following removal may look somewhat obscure and needs an explanation.
When we mutate the class hierarchy we create new classes for any existing subclass.
So it may look as if we don't have to remove the old class from its superclass. However,
at the top of the hierarchy (the first class we reshape) that superclass itself is not newly
created so therefore it will hold both the oldClass and newClass in its (obsolete or not)
subclasses. Since the #become: below will transparently replace the pointers to oldClass
with newClass the superclass would have newClass in its subclasses TWICE. With rather
unclear effects if we consider that we may convert the meta-class hierarchy itself (which
is derived from the non-meta class hierarchy).
Due to this problem ALL classes are removed from their superclass just prior to converting
them. Here, breaking the superclass/subclass invariant really doesn't matter since we will
effectively remove the oldClass (becomeForward:) just a few lines below."
oldClass superclass removeSubclass: oldClass.
oldClass superclass removeObsoleteSubclass: oldClass.
"make sure that the VM cache is clean"
oldClass methodDict do: [:cm | cm flushCache].
"Convert the instances of oldClass into instances of newClass"
newClass updateInstancesFrom: oldClass.
meta
ifTrue:
[oldClass becomeForward: newClass.
oldClass updateMethodBindingsTo: oldClass binding]
ifFalse:
[{oldClass. oldClass class} elementsForwardIdentityTo: {newClass. newClass class}.
oldClass updateMethodBindingsTo: oldClass binding.
oldClass class updateMethodBindingsTo: oldClass class binding].
"eem 5/31/2014 07:22 At this point there used to be a garbage collect whose purpose was
to ensure no old instances existed after the becomeForward:. Without the GC it was possible
to resurrect old instances using e.g. allInstancesDo:. This was because the becomeForward:
updated references from the old objects to new objects but didn't destroy the old objects.
But as of late 2013/early 2014 becomeForward: has been modified to free all the old objects."]
valueUnpreemptively
]
{ #category : #'method prototypes' }
SpurBootstrapSqueakFamilyPrototypes >> InstructionPrinterPROTOTYPEcallPrimitive: index [
"Print the callPrimitive bytecode."
self print: 'callPrimitive: ' , index printString
]