'From Squeak3.7alpha of ''11 September 2003'' [latest update: #5623] on 16 January 2004 at 3:54:29 pm'! "Change Set: KCP-0115-PrepareMovingChangesLog Date: 16 January 2004 Author: Nathanael Schaerli & Stephane Ducasse Moved changes file logging from SystemDictionary into SmalltalkImage. IMPORTANT: Load this changeset before KCP-0116!!!!"! !SmalltalkImage methodsFor: 'sources, changes log' stamp: 'NS 1/16/2004 15:34'! assureStartupStampLogged "If there is a startup stamp not yet actually logged to disk, do it now." | changesFile | StartupStamp ifNil: [^ self]. (SourceFiles isNil or: [(changesFile _ SourceFiles at: 2) == nil]) ifTrue: [^ self]. changesFile isReadOnly ifTrue:[^self]. changesFile setToEnd; cr; cr. changesFile nextChunkPut: StartupStamp asString; cr. StartupStamp _ nil. self forceChangesToDisk.! ! !SmalltalkImage methodsFor: 'sources, changes log' stamp: 'NS 1/16/2004 15:35'! forceChangesToDisk "Ensure that the changes file has been fully written to disk by closing and re-opening it. This makes the system more robust in the face of a power failure or hard-reboot." | changesFile | changesFile _ SourceFiles at: 2. (changesFile isKindOf: FileStream) ifTrue: [ changesFile flush. SecurityManager default hasFileAccess ifTrue:[ changesFile close. changesFile open: changesFile name forWrite: true]. changesFile setToEnd. ]. ! ! !SmalltalkImage methodsFor: 'sources, changes log' stamp: 'NS 1/16/2004 15:32'! logChange: aStringOrText "Write the argument, aString, onto the changes file." | aString changesFile | (SourceFiles isNil or: [(SourceFiles at: 2) == nil]) ifTrue: [^ self]. self assureStartupStampLogged. aStringOrText isText ifTrue: [aString _ aStringOrText string] ifFalse: [aString _ aStringOrText]. (aString isMemberOf: String) ifFalse: [self error: 'can''t log this change']. (aString findFirst: [:char | char isSeparator not]) = 0 ifTrue: [^ self]. "null doits confuse replay" (changesFile _ SourceFiles at: 2). changesFile isReadOnly ifTrue:[^self]. changesFile setToEnd; cr; cr. changesFile nextChunkPut: aString. "If want style changes in DoIt, use nextChunkPutWithStyle:, and allow Texts to get here" self forceChangesToDisk.! ! !SmalltalkImage methodsFor: 'sources, changes log' stamp: 'NS 1/16/2004 15:42'! saveAsEmbeddedImage "Save the current state of the system as an embedded image" | dir newName newImageName newImageSegDir oldImageSegDir haveSegs | dir _ FileDirectory default. newName _ FillInTheBlank request: 'Select existing VM file' initialAnswer: (FileDirectory localNameFor: ''). newName = '' ifTrue: [^ Smalltalk]. newName _ FileDirectory baseNameFor: newName asFileName. newImageName _ newName. (dir includesKey: newImageName) ifFalse: [^ self inform: 'Unable to find name ', newName, ' Please choose another name.']. haveSegs _ false. Smalltalk at: #ImageSegment ifPresent: [:theClass | (haveSegs _ theClass instanceCount ~= 0) ifTrue: [oldImageSegDir _ theClass segmentDirectory]]. self logChange: '----SAVEAS (EMBEDDED) ', newName, '----', Date dateAndTimeNow printString. self imageName: (dir fullNameFor: newImageName). LastImageName _ self imageName. self closeSourceFiles. haveSegs ifTrue: [Smalltalk at: #ImageSegment ifPresent: [:theClass | newImageSegDir _ theClass segmentDirectory. "create the folder" oldImageSegDir fileNames do: [:theName | "copy all segment files" newImageSegDir copyFileNamed: oldImageSegDir pathName, FileDirectory slash, theName toFileNamed: theName]]]. Smalltalk snapshot: true andQuit: true embedded: true ! ! !SmalltalkImage methodsFor: 'snapshot and quit' stamp: 'NS 1/16/2004 15:39'! snapshot: save andQuit: quit embedded: embeddedFlag "Mark the changes file and close all files. If save is true, save the current state of this Smalltalk in the image file. If quit is true, then exit to the outer shell. The latter part of this method runs when resuming a previously saved image. The resume logic checks for a document file to process when starting up." | resuming msg | Object flushDependents. Object flushEvents. (SourceFiles at: 2) ifNotNil:[ msg _ String streamContents: [ :s | s nextPutAll: '----'; nextPutAll: (save ifTrue: [ quit ifTrue: [ 'QUIT' ] ifFalse: [ 'SNAPSHOT' ] ] ifFalse: [quit ifTrue: [ 'QUIT/NOSAVE' ] ifFalse: [ 'NOP' ]]); nextPutAll: '----'; print: Date dateAndTimeNow; space; nextPutAll: (FileDirectory default localNameFor: self imageName); nextPutAll: ' priorSource: '; print: LastQuitLogPosition ]. self assureStartupStampLogged. save ifTrue: [ LastQuitLogPosition _ (SourceFiles at: 2) setToEnd; position ]. self logChange: msg. Transcript cr; show: msg ]. Smalltalk processShutDownList: quit. Cursor write show. save ifTrue: [resuming _ embeddedFlag ifTrue: [self snapshotEmbeddedPrimitive] ifFalse: [self snapshotPrimitive]. "<-- PC frozen here on image file" resuming == false "guard against failure" ifTrue: ["Time to reclaim segment files is immediately after a save" Smalltalk at: #ImageSegment ifPresent: [:theClass | theClass reclaimObsoleteSegmentFiles]]] ifFalse: [resuming _ false]. quit & (resuming == false) ifTrue: [self quitPrimitive]. Cursor normal show. Smalltalk setGCParameters. resuming == true ifTrue: [Smalltalk clearExternalObjects]. Smalltalk processStartUpList: resuming == true. resuming == true ifTrue:[ self setPlatformPreferences. self readDocumentFile]. Smalltalk isMorphic ifTrue: [SystemWindow wakeUpTopWindowUponStartup]. "Now it's time to raise an error" resuming == nil ifTrue: [self error:'Failed to write image file (disk full?)']. ^ resuming! !