[Vm-dev] mmap, changes to co-ordinate mapping to particular address to avoid oops address remapping at startup time.

David T. Lewis lewis at mail.msen.com
Thu Oct 30 12:00:56 UTC 2008


On Thu, Oct 23, 2008 at 06:52:25PM -0700, John M McIntosh wrote:
> Well it's not quite a straight forward
> 
> (a) you need to disable the image read logic I guess this could be in  
> the #define
> 
> So in  readImageFromFile: f HeapSize: desiredHeapSize StartingAt:  
> imageOffset

John,

Here is another try at it. The idea is to maintain backward compatibility
with the existing support code, so the Windows, Unix, and RiskOS support
code require no changes, but you can define your new mmap() allocators
in sqConfig.h:

#define allocateMemoryMinimumImageFileHeaderSize(heapSize, minimumMemory, fileStream, headerSize) \
    myMemoryAllocator(heapSize, minimumMemory, fileStream, headerSize)
#define sqImageFileReadEntireImage(memoryAddress, fileStream, elementSize,  length) \
    myImageFileReader(memoryAddress, fileStream, elementSize,  length)

> (b) free?
> Actually I'm not sure who if anyone ummaps memory on exit, however in  
> this case one does need to remember that memory points to the start of  
> file, not 0+headerSize
> For testing I've just remember the mmap for the file, and mmap for the  
> anonymous section.  However I'd guess a Hydra VM would have to do a  
> bit more to remember those
> two memory locations somewhere since I suspect the ability to startup  
> and shutdown an image is more likely without terminating the process  
> space.

It would be trivial to add this later on, so I think it would be best
to wait and see if Hydra needs it.

Dave

-------------- next part --------------
'From Squeak3.8.2a of ''26 Oct 2007'' [latest update: #6748] on 30 October 2008 at 7:43:50 am'!
"Change Set:		Interpreter-readImageFromFile-jmm-dtl
Date:			23 October 2008
Author:			David T. Lewis

Pass image file and image header length to object memory allocation function in order to enable mmap loading without address swizzling, per jmm proposal.

CCodeGenerator will provide default implementations in interp.h that are backward compatible with the existing platform support code. These defaults may be overridden by adding definitions such as the following to sqConfig.h (or config.h via configure for the unix VM).

#define allocateMemoryMinimumImageFileHeaderSize(heapSize, minimumMemory, fileStream, headerSize) \
    myMemoryAllocator(heapSize, minimumMemory, fileStream, headerSize)


#define sqImageFileReadEntireImage(memoryAddress, fileStream, elementSize,  length) \
    myImageFileReader(memoryAddress, fileStream, elementSize,  length)

"
!


!CCodeGenerator methodsFor: 'public' stamp: 'dtl 10/24/2008 12:51'!
storeHeaderOnFile: fileName bytesPerWord: bytesPerWord
	"Store C header code for this interpreter on the given file."

	| aStream |
	aStream := CrLfFileStream forceNewFileNamed: fileName.
	aStream ifNil: [Error signal: 'Could not open C header file: ', fileName].
	aStream
		nextPutAll: '/* ';
		nextPutAll: VMMaker headerNotice;
		nextPutAll: ' */'; cr; cr.
	self writeDefineBytesPerWord: bytesPerWord on: aStream.
	self writeDefineMemoryAccessInImageOn: aStream.
	self writeDefaultMacrosOn: aStream.
	aStream close
! !

!CCodeGenerator methodsFor: 'C code generator' stamp: 'dtl 10/30/2008 07:18'!
writeDefaultMacrosOn: aStream
	"Write macros to provide default implementations of certain functions used by
	the interpreter. If not previously defined in config.h they will be defined here.
	The definitions will be available to any module that includes sqMemoryAccess.h.
	The default macros are chosen for backward compatibility with existing platform
	support code."

	aStream cr;
		nextPutAll: '#ifndef allocateMemoryMinimumImageFileHeaderSize'; cr;
		nextPutAll: ' /* Called by Interpreter>>allocateMemory:minimum:imageFile:headerSize: */'; cr;
		nextPutAll: ' #define allocateMemoryMinimumImageFileHeaderSize(',
						'heapSize, minimumMemory, fileStream, headerSize) \'; cr;
		nextPutAll: '    sqAllocateMemory(minimumMemory, heapSize)'; cr;
		nextPutAll: '#endif'; cr; cr;
		nextPutAll: '#ifndef sqImageFileReadEntireImage'; cr;
		nextPutAll: ' /* Called by Interpreter>>sqImage:read:size:length: */'; cr;
		nextPutAll: ' #define sqImageFileReadEntireImage(memoryAddress, fileStream, ',
						'elementSize,  length) \'; cr;
		nextPutAll: '    sqImageFileRead(memoryAddress, fileStream, elementSize,  length)'; cr;
		nextPutAll: '#endif'; cr; cr
! !

!CCodeGenerator methodsFor: 'C code generator' stamp: 'dtl 8/25/2008 22:36'!
writeDefineBytesPerWord: bytesPerWord on: aStream
	aStream
		nextPutAll: '#define SQ_VI_BYTES_PER_WORD ';
		print: bytesPerWord;
		cr! !

!CCodeGenerator methodsFor: 'C code generator' stamp: 'dtl 9/17/2008 10:27'!
writeDefineMemoryAccessInImageOn: aStream
	"If MemoryAccess is present in the image, then define MEMORY_ACCESS_IN_IMAGE as
	a C preprocessor macro. When MEMORY_ACCESS_IN_IMAGE is defined, the traditional
	C preprocessor macros for low level memory access are ignored and will be replaced
	by directly translated (and inlined) SLANG versions of the same. This enables visibility
	of the memory access functions for debuggers and profilers."

	(Smalltalk classNamed: #MemoryAccess)
		ifNotNilDo: [:ma | ma isEnabled
			ifTrue: [aStream nextPutAll: '#define MEMORY_ACCESS_IN_IMAGE 1'; cr]]! !


!Interpreter methodsFor: 'image save/restore' stamp: 'dtl 10/30/2008 07:13'!
allocateMemory: heapSize minimum: minimumMemory imageFile: fileStream headerSize: headerSize

	"Translate to C function call with (case sensitive) camelCase. The purpose of this
	method is to document the translation.
	The default implementation is sqAllocateMemory(minimumMemory, heapSize). This may
	be redefined to make use of the image file and header size parameters for efficient
	implementation with mmap().
	See CCodeGenerator>>writeDefaultMacrosOn: which specifies a default implementation."

	self inline: true.
	self returnTypeC: 'char *'.
	self var: #fileStream type: 'sqImageFile'.
	^ self
		allocateMemory: heapSize
		Minimum: minimumMemory
		ImageFile: fileStream
		HeaderSize: headerSize! !

!Interpreter methodsFor: 'image save/restore' stamp: 'dtl 10/26/2008 16:37'!
readImageFromFile: f HeapSize: desiredHeapSize StartingAt: imageOffset
	"Read an image from the given file stream, allocating the given amount of memory to its object heap. Fail if the image has an unknown format or requires more than the given amount of memory."
	"Details: This method detects when the image was stored on a machine with the opposite byte ordering from this machine and swaps the bytes automatically. Furthermore, it allows the header information to start 512 bytes into the file, since some file transfer programs for the Macintosh apparently prepend a Mac-specific header of this size. Note that this same 512 bytes of prefix area could also be used to store an exec command on Unix systems, allowing one to launch Smalltalk by invoking the image name as a command."
	"This code is based on C code by Ian Piumarta and Smalltalk code by Tim Rowledge. Many thanks to both of you!!!!"

	| swapBytes headerStart headerSize dataSize oldBaseAddr minimumMemory memStart bytesRead bytesToShift heapSize |
	self var: #f type: 'sqImageFile '.
	self var: #headerStart type: 'squeakFileOffsetType '.
	self var: #dataSize type: 'size_t '.
	self var: #imageOffset type: 'squeakFileOffsetType '.

	swapBytes := self checkImageVersionFrom: f startingAt: imageOffset.
	headerStart := (self sqImageFilePosition: f) - BytesPerWord.  "record header start position"

	headerSize			:= self getLongFromFile: f swap: swapBytes.
	dataSize				:= self getLongFromFile: f swap: swapBytes.
	oldBaseAddr			:= self getLongFromFile: f swap: swapBytes.
	specialObjectsOop	:= self getLongFromFile: f swap: swapBytes.
	lastHash			:= self getLongFromFile: f swap: swapBytes.
	savedWindowSize	:= self getLongFromFile: f swap: swapBytes.
	fullScreenFlag		:= self getLongFromFile: f swap: swapBytes.
	extraVMMemory		:= self getLongFromFile: f swap: swapBytes.

	lastHash = 0 ifTrue: [
		"lastHash wasn't stored (e.g. by the cloner); use 999 as the seed"
		lastHash := 999].

	"decrease Squeak object heap to leave extra memory for the VM"
	heapSize := self cCode: 'reserveExtraCHeapBytes(desiredHeapSize, extraVMMemory)'.

	"compare memory requirements with availability".
	minimumMemory := dataSize + 100000.  "need at least 100K of breathing room"
	heapSize < minimumMemory ifTrue: [
		self insufficientMemorySpecifiedError].

	"allocate a contiguous block of memory for the Squeak heap"
	memory := self
		allocateMemory: heapSize
		minimum: minimumMemory
		imageFile: f
		headerSize: headerSize.
	memory = nil ifTrue: [self insufficientMemoryAvailableError].

	memStart := self startOfMemory.
	memoryLimit := (memStart + heapSize) - 24.  "decrease memoryLimit a tad for safety"
	endOfMemory := memStart + dataSize.

	"position file after the header"
	self sqImageFile: f Seek: headerStart + headerSize.

	"read in the image in bulk, then swap the bytes if necessary"
	bytesRead := self
		sqImage: (self pointerForOop: memory)
		read: f
		size: (self cCode: 'sizeof(unsigned char)')
		length: dataSize.
	bytesRead ~= dataSize ifTrue: [self unableToReadImageError].

	headerTypeBytes at: 0 put: BytesPerWord * 2.		"3-word header (type 0)"	
	headerTypeBytes at: 1 put: BytesPerWord.		"2-word header (type 1)"
	headerTypeBytes at: 2 put: 0.					"free chunk (type 2)"	
	headerTypeBytes at: 3 put: 0.					"1-word header (type 3)"

	swapBytes ifTrue: [self reverseBytesInImage].

	"compute difference between old and new memory base addresses"
	bytesToShift := memStart - oldBaseAddr.
	self initializeInterpreter: bytesToShift.  "adjusts all oops to new location"
	self isBigEnder. "work out the machine endianness and cache the answer"

	^ dataSize
! !

!Interpreter methodsFor: 'image save/restore' stamp: 'dtl 10/30/2008 07:15'!
sqImage: memoryAddress read: fileStream size: elementSize length: length
	"Normally implemented in support code as fread().
	See CCodeGenerator>>writeDefaultMacrosOn: which specifies a default implementation."
 
	self inline: true.
	self returnTypeC: 'size_t'.
	self var: #memoryAddress type: 'char *'.
	self var: #elementSize type: 'size_t'.
	self var: #length type: 'size_t'.
	self var: #fileStream type: 'sqImageFile'.
	^ self sqImage: memoryAddress File: elementSize  ReadEntire: length Image: fileStream 

! !

!Interpreter methodsFor: 'image save/restore' stamp: 'dtl 7/3/2008 20:21'!
sqImage: memoryAddress write: fileStream size: elementSize length: length
	"Normally implemented in support code as fwrite()"

	self inline: true.
	self returnTypeC: 'size_t'.
	self var: #memoryAddress type: 'char *'.
	self var: #elementSize type: 'size_t'.
	self var: #length type: 'size_t'.
	self var: #fileStream type: 'sqImageFile'.
	^ self sq: memoryAddress Image: elementSize File: length Write: fileStream "sqImageFileWrite()"
! !

!Interpreter methodsFor: 'image save/restore' stamp: 'dtl 7/3/2008 23:27'!
writeImageFileIO: imageBytes

	| headerStart headerSize f bytesWritten sCWIfn okToWrite |
	self var: #f type: 'sqImageFile'.
	self var: #headerStart type: 'squeakFileOffsetType '.
	self var: #sCWIfn type: 'void *'.

	"If the security plugin can be loaded, use it to check for write permission.
	If not, assume it's ok"
	sCWIfn := self ioLoadFunction: 'secCanWriteImage' From: 'SecurityPlugin'.
	sCWIfn ~= 0 ifTrue:[okToWrite := self cCode: '((sqInt (*)(void))sCWIfn)()'.
		okToWrite ifFalse:[^self primitiveFail]].
	
	"local constants"
	headerStart := 0.  
	headerSize := 64.  "header size in bytes; do not change!!"

	f := self cCode: 'sqImageFileOpen(imageName, "wb")'.
	f = nil ifTrue: [
		"could not open the image file for writing"
		self success: false.
		^ nil].

	headerStart := self cCode: 'sqImageFileStartLocation(f,imageName,headerSize+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 putLong: (self imageFormatVersion) toFile: f.
	self putLong: headerSize toFile: f.
	self putLong: imageBytes toFile: f.
	self putLong: (self startOfMemory) toFile: f.
	self putLong: specialObjectsOop toFile: f.
	self putLong: lastHash toFile: f.
	self putLong: (self ioScreenSize) toFile: f.
	self putLong: fullScreenFlag toFile: f.
	self putLong: extraVMMemory toFile: f.
	1 to: 7 do: [:i | self putLong: 0 toFile: f].  "fill remaining header words with zeros"
	successFlag ifFalse: [
		"file write or seek failure"
		self cCode: 'sqImageFileClose(f)'.
		^ nil].

	"position file after the header"
	self sqImageFile: f Seek: headerStart + headerSize.

	"write the image data"
	bytesWritten := self
		sqImage: (self pointerForOop: memory)
		write: f
		size: (self cCode: 'sizeof(unsigned char)')
		length: imageBytes.
	self success: bytesWritten = imageBytes.
	self cCode: 'sqImageFileClose(f)'.

! !



More information about the Vm-dev mailing list