2GB changes file and a pony (was: [squeak-dev] ALL CLEAR (Re: CompiledMethodTrailers ready for use))

David T. Lewis lewis at mail.msen.com
Wed Dec 23 20:23:46 UTC 2009


On Wed, Dec 23, 2009 at 10:27:42AM -0800, Eliot Miranda wrote:
> On Wed, Dec 23, 2009 at 6:43 AM, David T. Lewis <lewis at mail.msen.com> wrote:
> 
> > On Wed, Dec 23, 2009 at 10:27:29AM +0200, Igor Stasenko wrote:
> > > 2009/12/23 David T. Lewis <lewis at mail.msen.com>:
> > > > On Tue, Dec 22, 2009 at 01:59:34PM +0100, Andreas Raab wrote:
> > > >> Folks -
> > > >>
> > > >> We're all clear now after the CompiledMethodTrailer changes.
> > > >> Can I have a 2GB changes file now? And a pony? :)
> > > >>
> > > >
> > > > Here's the 2GB changes file patch. File it in, run tests, install
> > > > with ExpandedSourceFileArray install.
> > > >
> > >
> > > so, we're now bound to VM file-size handling limitation, or its using
> > > 64-bits for file pointers?
> > > 2GB is better than 32M.. but still small :)
> > >
> >
> > Now that CompiledMethod can address unlimited address space, all
> > that was required was to is to implement three small methods in
> > a subclass of SourceFileArray (*). So if somebody invents a file
> > system that maps to all the particles in the universe, we can
> > easily expand the changes file to make use if it. And as you point
> > out in another message, it should now be easier to map to things
> > that are not traditional file systems at all, which does open up
> > some interesting possibilities.
> >
> 
> I'm not up-to-date with the changes.  Are you making sure that the new
> source manager includes read-only copies of the source files so that
> fetching source does not involve creating a new file?

The class that I posted affects only the address mapping and would
not affect any other aspects of source file mapping.

That said, performance is poor so this is not ready for prime time.
I'm attaching an update that is somewhat less bad, but still nowhere
near good enough (3 or 4 times slower than StandardSourceFileArray).

I will not put this in the inbox until performance is at a more
reasonable level.  Help from the more capable bit twiddlers is
welcome (need a more efficient way to test an integer for bit
25 set).

Dave

-------------- next part --------------
'From Squeak3.10.2 of 22 December 2009 [latest update: #8530] on 23 December 2009 at 3:11:15 pm'!
"Change Set:		ExpandedSourceFileArray-dtl
Date:			23 December 2009
Author:			David T. Lewis

This is a variation on StandardSourceFileArray that provides a larger maximum changes file size.

The available address space for source pointers in a traditional CompiledMethod is 16r1000000 through 16r4FFFFFF. StandardSourceFileArray maps positions in the sources file to address range 16r1000000 through 16r1FFFFFF and 16r3000000 through 16r3FFFFFF, and positions in the changes file to address range 16r2000000 through 16r2FFFFFF and 16r4000000 through 16r4FFFFFF. This permits a maximum file size of 16r2000000 (32MB) for both the sources file and the changes file. 

This implementation extends the source pointer address space using bit 25 of the source pointer to identify the external sources and changes files, with the remaining high order bits treated as address extension. This limits the number of external file references to two (the traditional sources and changes files). If additional external file references are needed in the future, some higher order bits in the source pointer address space should be allocated for that purpose.

The use of bit 25 of the source pointer for file references permits backward compatibility with StandardSourceFileArray, with essentially unlimited address space expansion for the sources and changes files.
"!

SourceFileArray subclass: #ExpandedSourceFileArray
	instanceVariableNames: 'files'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Files-System'!

!ExpandedSourceFileArray commentStamp: 'dtl 12/22/2009 23:09' prior: 0!
This is a variation on StandardSourceFileArray that provides a larger maximum changes file size.

The available address space for source pointers in a traditional CompiledMethod is 16r1000000 through 16r4FFFFFF. StandardSourceFileArray maps positions in the sources file to address range 16r1000000 through 16r1FFFFFF and 16r3000000 through 16r3FFFFFF, and positions in the changes file to address range 16r2000000 through 16r2FFFFFF and 16r4000000 through 16r4FFFFFF. This permits a maximum file size of 16r2000000 (32MB) for both the sources file and the changes file. 

This implementation extends the source pointer address space using bit 25 of the source pointer to identify the external sources and changes files, with the remaining high order bits treated as address extension. This limits the number of external file references to two (the traditional sources and changes files). If additional external file references are needed in the future, some higher order bits in the source pointer address space should be allocated for that purpose.

The use of bit 25 of the source pointer for file references permits backward compatibility with StandardSourceFileArray, with essentially unlimited address space expansion for the sources and changes files.
!

TestCase subclass: #ExpandedSourceFileArrayTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Files-Tests'!

!ExpandedSourceFileArrayTest commentStamp: 'dtl 12/22/2009 23:10' prior: 0!
This test documents the source pointer address conversion methods for ExpandedSourceFileArray.

The available address space for source pointers in a traditional CompiledMethod is 16r1000000 through 16r4FFFFFF. StandardSourceFileArray maps positions in the sources file to address range 16r1000000 through 16r1FFFFFF and 16r3000000 through 16r3FFFFFF, and positions in the changes file to address range 16r2000000 through 16r2FFFFFF and 16r4000000 through 16r4FFFFFF. This permits a maximum file size of 16r2000000 (32MB) for both the sources file and the changes file. 

ExpandedSourceFileArray extends the source pointer address space using bit 25 of the source pointer to identify the external sources and changes files, with the remaining high order bits treated as address extension. This limits the number of external file references to two (the traditional sources and changes files). If additional external file references are needed in the future, some higher order bits in the source pointer address space should be allocated for that purpose.

The use of bit 25 of the source pointer for file references permits backward compatibility with StandardSourceFileArray, with essentially unlimited address space expansion for the sources and changes files.
!


!ExpandedSourceFileArray methodsFor: 'accessing' stamp: 'hmm 4/25/2000 21:20'!
at: index
	^files at: index! !

!ExpandedSourceFileArray methodsFor: 'accessing' stamp: 'hmm 4/25/2000 21:20'!
at: index put: aFile
	files at: index put: aFile! !

!ExpandedSourceFileArray methodsFor: 'accessing' stamp: 'hmm 4/25/2000 21:20'!
size
	^files size! !

!ExpandedSourceFileArray methodsFor: 'initialize-release' stamp: 'stephaneducasse 2/4/2006 20:32'!
initialize
	files := Array new: 2.
	files at: 1 put: (SourceFiles at: 1).
	files at: 2 put: (SourceFiles at: 2)! !

!ExpandedSourceFileArray methodsFor: 'initialize-release' stamp: 'stephaneducasse 2/4/2006 20:32'!
initialize: nFiles
	files := Array new: nFiles! !

!ExpandedSourceFileArray methodsFor: 'sourcePointer conversion' stamp: 'dtl 12/23/2009 11:48'!
fileIndexFromSourcePointer: anInteger
	"Return the index of the source file which contains the source chunk addressed by anInteger"

	(anInteger bitAnd: 16r1000000) ~= 0
		ifTrue: [^1 "sources file"]
		ifFalse: [^2 "changes file"]! !

!ExpandedSourceFileArray methodsFor: 'sourcePointer conversion' stamp: 'dtl 12/23/2009 11:50'!
filePositionFromSourcePointer: anInteger
	"Return the position of the source chunk addressed by anInteger"

	| hi lo |
	hi := anInteger // 16r2000000.
	lo := anInteger \\ 16r1000000.
	(anInteger bitAnd: 16r1000000) ~= 0
		ifTrue: [^hi * 16r1000000 + lo "sources file"]
		ifFalse: [^hi - 1 * 16r1000000 + lo "changes file"]	
! !

!ExpandedSourceFileArray methodsFor: 'sourcePointer conversion' stamp: 'dtl 12/23/2009 12:45'!
sourcePointerFromFileIndex: index andPosition: position
	"Return a sourcePointer encoding the given file index and position"

	| hi lo |
	(index = 1 or: [index = 2])
		ifFalse: [self error: 'invalid source file index'].
	position < 0 ifTrue: [self error: 'invalid source code pointer'].
	hi := position // 16r1000000 *2 + index.
	lo := position \\ 16r1000000.
	^ hi * 16r1000000 + lo
! !


!ExpandedSourceFileArray class methodsFor: 'initialize-release' stamp: 'dtl 12/22/2009 23:19'!
install
	"Replace SourceFiles by an instance of me with the standard sources and changes files.
	This only works if SourceFiles is either an Array or an instance of this class"

	"ExpandedSourceFileArray install"

	SourceFiles := self new! !

!ExpandedSourceFileArray class methodsFor: 'initialize-release' stamp: 'ar 5/17/2000 18:27'!
new: nFiles
	^self new initialize: nFiles.! !


!ExpandedSourceFileArrayTest methodsFor: 'testing' stamp: 'dtl 12/22/2009 23:05'!
testAddressRange
	"Test source pointer to file position address translation across a wide address range"
	
	| sf i p a |
	sf := ExpandedSourceFileArray new.
	(16r1000000 to: 16r10000000 by: 4093) do: [:e |
		i := sf fileIndexFromSourcePointer: e.
		p := sf filePositionFromSourcePointer: e.
		a := sf sourcePointerFromFileIndex: i andPosition: p.
		self assert: a = e]
! !

!ExpandedSourceFileArrayTest methodsFor: 'testing' stamp: 'dtl 12/22/2009 23:05'!
testChangesFileAddressRange
	"Test file position to source pointer address translation for the changes file"
	
	| sf i p a a2 |
	sf := ExpandedSourceFileArray new.
	(0 to: 16r1FFFFFFF by: 4093) do: [:e |
		a := sf sourcePointerFromFileIndex: 2 andPosition: e.
		i := sf fileIndexFromSourcePointer: a.
		self assert: i == 2.
		p := sf filePositionFromSourcePointer: a.
		self assert: p = e.
		a2 := sf sourcePointerFromFileIndex: 2 andPosition: p.
		self assert: a2 = a].
	(0 to: 16rFFFFFF by: 811) do: [:e |
		a := sf sourcePointerFromFileIndex: 2 andPosition: e.
		self assert: (a between: 16r2000000 and: 16r2FFFFFF)].
	(16r1000000 to: 16r1FFFFFF by: 811) do: [:e |
		a := sf sourcePointerFromFileIndex: 2 andPosition: e.
		self assert: (a between: 16r4000000 and: 16r4FFFFFF)].
	(16r2000000 to: 16r2FFFFFF by: 811) do: [:e |
		a := sf sourcePointerFromFileIndex: 2 andPosition: e.
		self assert: (a between: 16r6000000 and: 16r6FFFFFF)].
	(16r3000000 to: 16r3FFFFFF by: 811) do: [:e |
		a := sf sourcePointerFromFileIndex: 2 andPosition: e.
		self assert: (a between: 16r8000000 and: 16r8FFFFFF)].
	(16r4000000 to: 16r4FFFFFF by: 811) do: [:e |
		a := sf sourcePointerFromFileIndex: 2 andPosition: e.
		self assert: (a between: 16rA000000 and: 16rAFFFFFF)].
	(16r5000000 to: 16r5FFFFFF by: 811) do: [:e |
		a := sf sourcePointerFromFileIndex: 2 andPosition: e.
		self assert: (a between: 16rC000000 and: 16rCFFFFFF)].
	(16r6000000 to: 16r6FFFFFF by: 811) do: [:e |
		a := sf sourcePointerFromFileIndex: 2 andPosition: e.
		self assert: (a between: 16rE000000 and: 16rEFFFFFF)].
	(16r7000000 to: 16r7FFFFFF by: 811) do: [:e |
		a := sf sourcePointerFromFileIndex: 2 andPosition: e.
		self assert: (a between: 16r10000000 and: 16r10FFFFFF)]



! !

!ExpandedSourceFileArrayTest methodsFor: 'testing' stamp: 'dtl 12/23/2009 00:24'!
testFileIndexFromSourcePointer
	"Test derivation of file index for sources or changes file from source pointers"

	| sf |
	sf := ExpandedSourceFileArray new.
	"sources file mapping"
	self assert: 1 = (sf fileIndexFromSourcePointer: 16r1000000).
	self assert: 1 = (sf fileIndexFromSourcePointer: 16r1000013).
	self assert: 1 = (sf fileIndexFromSourcePointer: 16r1FFFFFF).
	self assert: 1 = (sf fileIndexFromSourcePointer: 16r3000000).
	self assert: 1 = (sf fileIndexFromSourcePointer: 16r3000013).
	self assert: 1 = (sf fileIndexFromSourcePointer: 16r3FFFFFF).

	self assert: 1 = (sf fileIndexFromSourcePointer: 16r5000000).
	self assert: 1 = (sf fileIndexFromSourcePointer: 16r5000013).
	self assert: 1 = (sf fileIndexFromSourcePointer: 16r5FFFFFF).

	(16r1000000 to: 16r1FFFFFF by: 811) do: [:e | self assert: 1 = (sf fileIndexFromSourcePointer: e)].
	(16r3000000 to: 16r3FFFFFF by: 811) do: [:e | self assert: 1 = (sf fileIndexFromSourcePointer: e)].
	"changes file mapping"
	self assert: 2 = (sf fileIndexFromSourcePointer: 16r2000000).
	self assert: 2 = (sf fileIndexFromSourcePointer: 16r2000013).
	self assert: 2 = (sf fileIndexFromSourcePointer: 16r2FFFFFF).
	self assert: 2 = (sf fileIndexFromSourcePointer: 16r4000000).
	self assert: 2 = (sf fileIndexFromSourcePointer: 16r4000013).
	self assert: 2 = (sf fileIndexFromSourcePointer: 16r4FFFFFF).

	self assert: 2 = (sf fileIndexFromSourcePointer: 16r6000000).
	self assert: 2 = (sf fileIndexFromSourcePointer: 16r6000013).
	self assert: 2 = (sf fileIndexFromSourcePointer: 16r6FFFFFF).

	(16r2000000 to: 16r2FFFFFF by: 811) do: [:e | self assert: 2 = (sf fileIndexFromSourcePointer: e)].
	(16r4000000 to: 16r4FFFFFF by: 811) do: [:e | self assert: 2 = (sf fileIndexFromSourcePointer: e)].


! !

!ExpandedSourceFileArrayTest methodsFor: 'testing' stamp: 'dtl 12/22/2009 23:05'!
testFilePositionFromSourcePointer
	"Test derivation of file position for sources or changes file from source pointers"

	| sf |
	sf := ExpandedSourceFileArray new.
	"sources file"
	self assert: 0 = (sf filePositionFromSourcePointer: 16r1000000).
	self assert: 16r13 = (sf filePositionFromSourcePointer: 16r1000013).
	self assert: 16rFFFFFF = (sf filePositionFromSourcePointer: 16r1FFFFFF).
	self assert: 16r1000000 = (sf filePositionFromSourcePointer: 16r3000000).
	self assert: 16r1000013 = (sf filePositionFromSourcePointer: 16r3000013).
	self assert: 16r1FFFFFF = (sf filePositionFromSourcePointer: 16r3FFFFFF).
	"changes file"
	self assert: 0 = (sf filePositionFromSourcePointer: 16r2000000).
	self assert: 16r13 = (sf filePositionFromSourcePointer: 16r2000013).
	self assert: 16rFFFFFF = (sf filePositionFromSourcePointer: 16r2FFFFFF).
	self assert: 16r1000000 = (sf filePositionFromSourcePointer: 16r4000000).
	self assert: 16r1000013 = (sf filePositionFromSourcePointer: 16r4000013).
	self assert: 16r1FFFFFF = (sf filePositionFromSourcePointer: 16r4FFFFFF).
	"the following numeric ranges are unused but currently produces results as follows"
	"self assert: 0 = (sf filePositionFromSourcePointer: 16r0000000).
	self assert: 16r13 = (sf filePositionFromSourcePointer: 16r0000013).
	self assert: 16rFFFFFF = (sf filePositionFromSourcePointer: 16r0FFFFFF)"
! !

!ExpandedSourceFileArrayTest methodsFor: 'testing' stamp: 'dtl 12/22/2009 23:05'!
testSourcePointerFromFileIndexAndPosition
	"Test valid input ranges"

	| sf |
	sf := ExpandedSourceFileArray new.
	self should: [sf sourcePointerFromFileIndex: 0 andPosition: 0] raise: Error.
	self shouldnt: [sf sourcePointerFromFileIndex: 1 andPosition: 0] raise: Error.
	self shouldnt: [sf sourcePointerFromFileIndex: 2 andPosition: 0] raise: Error.
	self should: [sf sourcePointerFromFileIndex: 0 andPosition: 3] raise: Error.
	self should: [sf sourcePointerFromFileIndex: 1 andPosition: -1] raise: Error.
	self shouldnt: [sf sourcePointerFromFileIndex: 1 andPosition: 16r1FFFFFF] raise: Error.
	self shouldnt: [sf sourcePointerFromFileIndex: 1 andPosition: 16r2000000] raise: Error.
	self should: [sf sourcePointerFromFileIndex: 3 andPosition: 0] raise: Error.
	self should: [sf sourcePointerFromFileIndex: 4 andPosition: 0] raise: Error.
	
	self assert: 16r1000000 = (sf sourcePointerFromFileIndex: 1 andPosition: 0).
	self assert: 16r1000013 = (sf sourcePointerFromFileIndex: 1 andPosition: 16r13).
	self assert: 16r1FFFFFF = (sf sourcePointerFromFileIndex: 1 andPosition: 16rFFFFFF).
	self assert: 16r2000000 = (sf sourcePointerFromFileIndex: 2 andPosition: 0).
	self assert: 16r2000013 = (sf sourcePointerFromFileIndex: 2 andPosition: 16r13).
	self assert: 16r2FFFFFF = (sf sourcePointerFromFileIndex: 2 andPosition: 16rFFFFFF).
	self assert: 16r3000000 = (sf sourcePointerFromFileIndex: 1 andPosition: 16r1000000).
	self assert: 16r3000013 = (sf sourcePointerFromFileIndex: 1 andPosition: 16r1000013).
	self assert: 16r3FFFFFF = (sf sourcePointerFromFileIndex: 1 andPosition: 16r1FFFFFF).
	self assert: 16r4000000 = (sf sourcePointerFromFileIndex: 2 andPosition: 16r1000000).
	self assert: 16r4000013 = (sf sourcePointerFromFileIndex: 2 andPosition: 16r1000013).
	self assert: 16r4FFFFFF = (sf sourcePointerFromFileIndex: 2 andPosition: 16r1FFFFFF)
! !

!ExpandedSourceFileArrayTest methodsFor: 'testing' stamp: 'dtl 12/22/2009 23:05'!
testSourcesFileAddressRange
	"Test file position to source pointer address translation for the sources file"
	
	| sf i p a a2 |
	sf := ExpandedSourceFileArray new.
	(0 to: 16r1FFFFFFF by: 4093) do: [:e |
		a := sf sourcePointerFromFileIndex: 1 andPosition: e.
		i := sf fileIndexFromSourcePointer: a.
		self assert: i == 1.
		p := sf filePositionFromSourcePointer: a.
		self assert: p = e.
		a2 := sf sourcePointerFromFileIndex: 1 andPosition: p.
		self assert: a2 = a].
	(0 to: 16rFFFFFF by: 811) do: [:e |
		a := sf sourcePointerFromFileIndex: 1 andPosition: e.
		self assert: (a between: 16r1000000 and: 16r1FFFFFF)].
	(16r1000000 to: 16r1FFFFFF by: 811) do: [:e |
		a := sf sourcePointerFromFileIndex: 1 andPosition: e.
		self assert: (a between: 16r3000000 and: 16r3FFFFFF)].

	(16r2000000 to: 16r2FFFFFF by: 811) do: [:e |
		a := sf sourcePointerFromFileIndex: 1 andPosition: e.
		self assert: (a between: 16r5000000 and: 16r5FFFFFF)].
	(16r3000000 to: 16r3FFFFFF by: 811) do: [:e |
		a := sf sourcePointerFromFileIndex: 1 andPosition: e.
		self assert: (a between: 16r7000000 and: 16r7FFFFFF)].
	(16r4000000 to: 16r4FFFFFF by: 811) do: [:e |
		a := sf sourcePointerFromFileIndex: 1 andPosition: e.
		self assert: (a between: 16r9000000 and: 16r9FFFFFF)].
	(16r5000000 to: 16r5FFFFFF by: 811) do: [:e |
		a := sf sourcePointerFromFileIndex: 1 andPosition: e.
		self assert: (a between: 16rB000000 and: 16rBFFFFFF)].
	(16r6000000 to: 16r6FFFFFF by: 811) do: [:e |
		a := sf sourcePointerFromFileIndex: 1 andPosition: e.
		self assert: (a between: 16rD000000 and: 16rDFFFFFF)].
	(16r7000000 to: 16r7FFFFFF by: 811) do: [:e |
		a := sf sourcePointerFromFileIndex: 1 andPosition: e.
		self assert: (a between: 16rF000000 and: 16rFFFFFFF)]
! !



More information about the Squeak-dev mailing list