-
Notifications
You must be signed in to change notification settings - Fork 67
/
SpurImageWriter.class.st
258 lines (202 loc) · 7.96 KB
/
SpurImageWriter.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
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
Class {
#name : #SpurImageWriter,
#superclass : #AbstractImageAccess,
#category : #'VMMaker-ImageFormat'
}
{ #category : #writing }
SpurImageWriter >> padHeader: emptySize toFile: f [
emptySize timesRepeat: [self putLong: 0 toFile: f].
objectMemory wordSize = 8 ifTrue:
[3 timesRepeat: [self putLong: 0 toFile: f]]. "Pad the rest of the header."
]
{ #category : #writing }
SpurImageWriter >> putLong: aLong toFile: aFile [
"Append aLong to aFile in this platform's 'natural' byte order. aLong is either 32 or 64 bits,
depending on ObjectMemory. (Bytes will be swapped, if necessary, when the image is read
on a different platform.) Set successFlag to false if the write fails."
<var: #aLong type: #sqInt>
<var: #aFile type: #sqImageFile>
<inline: false>
| objectsWritten |
objectsWritten := self
cCode: [self sq: (self addressOf: aLong) Image: (self sizeof: #sqInt) File: 1 Write: aFile]
inSmalltalk:
[| value |
value := aLong.
objectMemory wordSize timesRepeat:
[aFile nextPut: (value bitAnd: 16rFF).
value := value >> 8].
1].
interpreter success: objectsWritten = 1
]
{ #category : #writing }
SpurImageWriter >> putShort: aShort toFile: aFile [
"Append the 16-bit aShort to aFile in this platform's 'natural' byte order.
(Bytes will be swapped, if necessary, when the image is read on a
different platform.) Set successFlag to false if the write fails."
<var: #aShort type: #short>
<var: #aFile type: #sqImageFile>
<inline: false>
| objectsWritten |
objectsWritten := self
cCode: [self sq: (self addressOf: aShort) Image: (self sizeof: #short) File: 1 Write: aFile]
inSmalltalk:
[aFile
nextPut: (aShort bitAnd: 16rFF);
nextPut: (aShort >> 8 bitAnd: 16rFF).
1].
interpreter success: objectsWritten = 1
]
{ #category : #writing }
SpurImageWriter >> putWord32: aWord32 toFile: aFile [
"Append aWord32 to aFile in this platform's 'natural' byte order. aWord32 is 32 bits,
depending on ObjectMemory. (Bytes will be swapped, if necessary, when the image is read
on a different platform.) Set successFlag to false if the write fails."
<var: #aWord32 type: #int>
<var: #aFile type: #sqImageFile>
<inline: false>
| objectsWritten |
objectsWritten := self
cCode: [self sq: (self addressOf: aWord32) Image: 4 File: 1 Write: aFile]
inSmalltalk:
[| value |
value := aWord32.
4 timesRepeat:
[aFile nextPut: (value bitAnd: 16rFF).
value := value >> 8].
1].
interpreter success: objectsWritten = 1
]
{ #category : #'accessing - files' }
SpurImageWriter >> sqImage: file File: imageName StartLocation: location [
<doNotGenerate>
^0
]
{ #category : #'accessing - files' }
SpurImageWriter >> sqImageFile: imageName Open: fileMode [
<doNotGenerate>
^imageName asFileReference binaryWriteStream
]
{ #category : #'accessing - files' }
SpurImageWriter >> sqImageFileClose: file [
<doNotGenerate>
file close
]
{ #category : #'accessing - files' }
SpurImageWriter >> sqImageFilePosition: file [
<doNotGenerate>
^file position
]
{ #category : #writing }
SpurImageWriter >> writeHeader: header toFile: f [
self putWord32: header imageFormat toFile: f.
self putWord32: header imageHeaderSize toFile: f.
self putLong: header dataSize toFile: f.
self putLong: header oldBaseAddr toFile: f.
self putLong: header initialSpecialObjectsOop toFile: f.
self putLong: header hdrLastHash toFile: f.
self putLong: header screenSize toFile: f.
self putLong: header headerFlags toFile: f.
self putWord32: header extraVMMemory toFile: f.
self putShort: header hdrNumStackPages toFile: f.
self putShort: header hdrCogCodeSize toFile: f.
self putWord32: header hdrEdenBytes toFile: f.
self putShort: header hdrMaxExtSemTabSize toFile: f.
self putShort: 0 toFile: f. "the2ndUnknownShort"
]
{ #category : #writing }
SpurImageWriter >> writeImageFile: imageFileName fromHeader: header [
"Write the image header and heap contents to imageFile for snapshot. c.f. writeImageFileIOSimulation.
The game below is to maintain 64-bit alignment for all putLong:toFile: occurrences."
<var: #headerStart type: #squeakFileOffsetType>
<var: #imageFileName declareC: 'char *imageFileName'>
<var: #f type: #sqImageFile>
<var: #header type: #SpurImageHeaderStruct>
| headerStart imageHeaderSize f imageBytes bytesWritten |
headerStart := 0.
imageHeaderSize := header imageHeaderSize.
self logDebug: 'Writing snapshot file %s' _: imageFileName.
f := self sqImageFile: imageFileName Open: 'wb'.
f ifNil: [ "could not open the image file for writing"
^ self primitiveFail ].
imageBytes := header dataSize.
headerStart := self
sqImage: f
File: imageFileName
StartLocation: imageHeaderSize + imageBytes.
self cCode:
'/* Note: on Unix systems one could put an exec command here, padded to 512 bytes */'.
"position file to start of header"
self sqImageFile: f Seek: headerStart.
self writeHeader: header toFile: f.
self putLong: objectMemory firstSegmentBytes toFile: f.
self putLong: objectMemory bytesLeftInOldSpace toFile: f.
self padHeader: 2 toFile: f.
"position file after the header"
self assert:
headerStart + imageHeaderSize = (self sqImageFilePosition: f).
self sqImageFile: f Seek: headerStart + imageHeaderSize.
interpreter successful ifFalse: [ "file write or seek failure"
self sqImageFileClose: f.
^ nil ].
"write the image data"
bytesWritten := self writeImageSegmentsToFile: f.
interpreter success: bytesWritten = imageBytes.
self sqImageFileClose: f.
self logDebug: 'Snapshot file %s done' _: imageFileName
]
{ #category : #writing }
SpurImageWriter >> writeImageSegmentsToFile: aBinaryStream [
<var: 'aBinaryStream' type: #sqImageFile>
<var: 'aSegment' type:#'SpurSegmentInfo *'>
<inline: false>
| total |
self assert: segmentManager firstSegmentBytes > 0.
total := 0.
segmentManager withNonEmptySegmentsDo: [ :aSegment :segmentIndex |
total := total + (self writeSegment: aSegment
nextSegment: (segmentManager nextNonEmptySegmentAfter: segmentIndex)
toFile: aBinaryStream) ].
^total
]
{ #category : #writing }
SpurImageWriter >> writeSegment: segment nextSegment: nextSegment toFile: aBinaryStream [
"Write the segment contents, the size of and the distance to the next segment to aBinaryStream."
<var: 'segment' type: #'SpurSegmentInfo *'>
<var: 'nextSegment' type: #'SpurSegmentInfo *'>
<var: 'aBinaryStream' type: #sqImageFile>
<var: 'firstSavedBridgeWord' type: #usqLong>
<var: 'secondSavedBridgeWord' type: #usqLong>
| pier1 pier2 firstSavedBridgeWord secondSavedBridgeWord nWritten |
pier1 := segment segLimit - objectMemory bridgeSize.
pier2 := pier1 + objectMemory baseHeaderSize.
self assert: (segmentManager isValidSegmentBridge: (segmentManager bridgeFor: segment)).
self assert: (objectMemory startOfObject: (segmentManager bridgeFor: segment)) = pier1.
"Temporarily change the bridge to bridge to the next non-empty segment.
The first double word of the bridge includes the bridge size in slots, and
hence specifies the distance to the next segment. The following double
word is replaced by the size of the next segment, or 0 if there isn't one."
firstSavedBridgeWord := objectMemory long64At: pier1.
secondSavedBridgeWord := objectMemory long64At: pier2.
segmentManager bridgeFrom: segment to: nextSegment.
objectMemory
long64At: pier2
put: (nextSegment ifNil: [0] ifNotNil: [nextSegment segSize]).
nWritten := self cCode:
[self
sq: segment segStart asVoidPointer
Image: 1
File: segment segSize
Write: aBinaryStream]
inSmalltalk: [ | region |
region := (objectMemory memoryManager regionForAddress: segment segStart).
aBinaryStream
next: segment segSize
putAll: region memory
startingAt: segment segStart - region start + 1.
segment segSize].
objectMemory
long64At: pier1 put: firstSavedBridgeWord;
long64At: pier2 put: secondSavedBridgeWord.
^nWritten
]