[Vm-dev] VM Maker: VMMaker.oscog-eem.597.mcz
Eliot Miranda
eliot.miranda at gmail.com
Fri Jan 31 00:41:18 UTC 2014
Hi All,
I'd be grateful for a second set of eyes to review my changes in plugin
land. The idea here was to eliminate as many isIntegerObject: sends where
the intent is to fail if interpreterProxy isImmediate:. There are other
cleanups too; some places where it is assumed the start of an object is
object + 4 (instead of object + BaseHeaderSize, which hopefully will fix
some Spur bugs, where BaseHeaderSize is 8). But there are a fair few fixes
and I could have made a mistake.
TIA
On Thu, Jan 30, 2014 at 4:33 PM, <commits at source.squeak.org> wrote:
>
> Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
> http://source.squeak.org/VMMaker/VMMaker.oscog-eem.597.mcz
>
> ==================== Summary ====================
>
> Name: VMMaker.oscog-eem.597
> Author: eem
> Time: 30 January 2014, 4:31:41.523 pm
> UUID: c9a71dd4-c394-4a8f-aa4d-a6d4dc3ff220
> Ancestors: VMMaker.oscog-eem.596
>
> Fix markAndTraceStackPage: for Spur. Stack references to
> forwarders must be followed before calling markAndTrace:.
>
> Fix eliminateAndFreeForwarders; it assumed that no forwarder can
> reference a new object after scavenge. That's not true due to
> transitive references.
>
> Fix SpurMemoryManager>>become:with:twoWay:copyHash: to follow
> the specialObjectsOop if it has been forwarded.
>
> Plugins (and the form print prim):
> Fix some egregious oop + 4 and oop + 8 references with the correct
> oop + BaseHeaderSize.
> Reduce the use of isIntegerObject:. isWords:, isBytes:
> et al fail for immediates anyway.
> Use var:type: where appropriate and use symbols for 'char *' et al.
> Replace some uses of cCode: 'aFunction(args)' with a send of the
> equivalent albeit non-existent selector. This may allow simulation
> at some point in the future.
>
> =============== Diff against VMMaker.oscog-eem.596 ===============
>
> Item was changed:
> ----- Method: AsynchFilePlugin>>asyncFileValueOf: (in category
> 'primitives') -----
> asyncFileValueOf: oop
> + "Answer a pointer to the first byte of the async file record
> within the given Smalltalk bytes object, or nil if oop is not an async file
> record."
> - "Return a pointer to the first byte of the async file record
> within the given Smalltalk bytes object, or nil if oop is not an async file
> record."
>
> <returnTypeC: 'AsyncFile *'>
> interpreterProxy success:
> + ((interpreterProxy isBytes: oop)
> + and: [(interpreterProxy slotSizeOf: oop) = (self cCode:
> 'sizeof(AsyncFile)')]).
> + ^interpreterProxy failed
> + ifTrue: [nil]
> + ifFalse: [self cCoerceSimple: (interpreterProxy
> firstIndexableField: oop) to: 'AsyncFile *']!
> - ((interpreterProxy isIntegerObject: oop) not and:
> - [(interpreterProxy isBytes: oop) and:
> - [(interpreterProxy slotSizeOf: oop) = (self cCode:
> 'sizeof(AsyncFile)')]]).
> - interpreterProxy failed ifTrue: [^ nil].
> - ^ self cCode: '(AsyncFile *) (oop + 4)'
> - !
>
> Item was changed:
> ----- Method: B3DAcceleratorPlugin>>stackLightArrayValue: (in category
> 'primitive support') -----
> stackLightArrayValue: stackIndex
> "Load an Array of B3DPrimitiveLights from the given stack index"
> | oop array arraySize |
> <inline: false>
> array := interpreterProxy stackObjectValue: stackIndex.
> + array = nil ifTrue:[^nil]. "really??"
> - array = nil ifTrue:[^nil].
> array = interpreterProxy nilObject ifTrue:[^nil].
> + (interpreterProxy isArray: array)
> - (interpreterProxy fetchClassOf: array) = interpreterProxy
> classArray
> ifFalse:[^interpreterProxy primitiveFail].
> arraySize := interpreterProxy slotSizeOf: array.
> 0 to: arraySize-1 do:[:i|
> oop := interpreterProxy fetchPointer: i ofObject: array.
> - (interpreterProxy isIntegerObject: oop)
> - ifTrue:[^interpreterProxy primitiveFail].
> ((interpreterProxy isWords: oop) and:[(interpreterProxy
> slotSizeOf: oop) = 32])
> ifFalse:[^interpreterProxy primitiveFail].
> ].
> ^array!
>
> Item was changed:
> ----- Method: BalloonEngineBase>>loadFormsFrom: (in category 'loading
> state') -----
> loadFormsFrom: arrayOop
> "Check all the forms from arrayOop."
> | formOop bmBits bmBitsSize bmWidth bmHeight bmDepth ppw bmRaster |
> (interpreterProxy isArray: arrayOop) ifFalse:[^false].
> formArray := arrayOop.
> 0 to: (interpreterProxy slotSizeOf: formArray) - 1 do:[:i|
> formOop := interpreterProxy fetchPointer: i ofObject:
> formArray.
> - (interpreterProxy isIntegerObject: formOop)
> ifTrue:[^false].
> (interpreterProxy isPointers: formOop) ifFalse:[^false].
> (interpreterProxy slotSizeOf: formOop) < 5 ifTrue:[^false].
> bmBits := interpreterProxy fetchPointer: 0 ofObject:
> formOop.
> + (interpreterProxy fetchClassOf: bmBits) = interpreterProxy
> classBitmap
> - (interpreterProxy fetchClassOf: bmBits) ==
> interpreterProxy classBitmap
> ifFalse:[^false].
> bmBitsSize := interpreterProxy slotSizeOf: bmBits.
> bmWidth := interpreterProxy fetchInteger: 1 ofObject:
> formOop.
> bmHeight := interpreterProxy fetchInteger: 2 ofObject:
> formOop.
> bmDepth := interpreterProxy fetchInteger: 3 ofObject:
> formOop.
> interpreterProxy failed ifTrue:[^false].
> (bmWidth >= 0 and:[bmHeight >= 0]) ifFalse:[^false].
> ppw := 32 // bmDepth.
> bmRaster := bmWidth + (ppw-1) // ppw.
> bmBitsSize = (bmRaster * bmHeight)
> ifFalse:[^false].
> ].
> ^true!
>
> Item was changed:
> ----- Method: BalloonEngineBase>>primitiveGetFailureReason (in category
> 'primitives-access') -----
> primitiveGetFailureReason
> "Return the reason why the last operation failed."
> <export: true>
> <inline: false>
> | failCode |
> interpreterProxy methodArgumentCount = 0
> ifFalse:[^interpreterProxy primitiveFailFor:
> PrimErrBadNumArgs].
> engine := interpreterProxy stackValue: 0.
> "Note -- don't call loadEngineFrom here because this will override
> the stopReason with Zero"
> + (interpreterProxy isImmediate: engine) ifTrue:[^interpreterProxy
> primitiveFailFor: GEFEngineIsInteger].
> - (interpreterProxy isIntegerObject: engine)
> ifTrue:[^interpreterProxy primitiveFailFor: GEFEngineIsInteger].
> (interpreterProxy isPointers: engine) ifFalse:[^interpreterProxy
> primitiveFailFor: GEFEngineIsWords].
> (interpreterProxy slotSizeOf: engine) < BEBalloonEngineSize
> ifTrue:[^interpreterProxy primitiveFailFor: GEFEngineTooSmall].
> (failCode := self loadWorkBufferFrom:
> (interpreterProxy fetchPointer: BEWorkBufferIndex
> ofObject: engine)) = 0
> ifFalse:[^interpreterProxy primitiveFailFor:
> failCode].
> interpreterProxy pop: 1.
> interpreterProxy pushInteger: self stopReasonGet.!
>
> Item was changed:
> ----- Method:
> BalloonEnginePlugin>>loadBitmapFill:colormap:tile:from:along:normal:xIndex:
> (in category 'fills-bitmaps') -----
> loadBitmapFill: formOop colormap: cmOop tile: tileFlag from: point1
> along: point2 normal: point3 xIndex: xIndex
> "Load the bitmap fill."
> | bmFill cmSize cmBits bmBits bmBitsSize bmWidth bmHeight bmDepth
> ppw bmRaster |
> + <var: #cmBits type: #'int *'>
> + <var: #point1 type: #'int *'>
> + <var: #point2 type: #'int *'>
> + <var: #point3 type: #'int *'>
> - <var: #cmBits type:'int *'>
> - <var: #point1 type:'int *'>
> - <var: #point2 type:'int *'>
> - <var: #point3 type:'int *'>
>
> cmOop == interpreterProxy nilObject ifTrue:[
> cmSize := 0.
> cmBits := nil.
> ] ifFalse:[
> + (interpreterProxy fetchClassOf: cmOop) = interpreterProxy
> classBitmap
> - (interpreterProxy fetchClassOf: cmOop) == interpreterProxy
> classBitmap
> ifFalse:[^interpreterProxy primitiveFail].
> cmSize := interpreterProxy slotSizeOf: cmOop.
> cmBits := interpreterProxy firstIndexableField: cmOop.
> ].
> - (interpreterProxy isIntegerObject: formOop)
> - ifTrue:[^interpreterProxy primitiveFail].
> (interpreterProxy isPointers: formOop)
> ifFalse:[^interpreterProxy primitiveFail].
> (interpreterProxy slotSizeOf: formOop) < 5
> ifTrue:[^interpreterProxy primitiveFail].
> bmBits := interpreterProxy fetchPointer: 0 ofObject: formOop.
> + (interpreterProxy fetchClassOf: bmBits) = interpreterProxy
> classBitmap
> - (interpreterProxy fetchClassOf: bmBits) == interpreterProxy
> classBitmap
> ifFalse:[^interpreterProxy primitiveFail].
> bmBitsSize := interpreterProxy slotSizeOf: bmBits.
> bmWidth := interpreterProxy fetchInteger: 1 ofObject: formOop.
> bmHeight := interpreterProxy fetchInteger: 2 ofObject: formOop.
> bmDepth := interpreterProxy fetchInteger: 3 ofObject: formOop.
> interpreterProxy failed ifTrue:[^nil].
> (bmWidth >= 0 and:[bmHeight >= 0]) ifFalse:[^interpreterProxy
> primitiveFail].
> (bmDepth = 32) | (bmDepth = 8) | (bmDepth = 16) |
> (bmDepth = 1) | (bmDepth = 2) | (bmDepth = 4)
> ifFalse:[^interpreterProxy primitiveFail].
> (cmSize = 0 or:[cmSize = (1 << bmDepth)])
> ifFalse:[^interpreterProxy primitiveFail].
> ppw := 32 // bmDepth.
> bmRaster := bmWidth + (ppw-1) // ppw.
> bmBitsSize = (bmRaster * bmHeight)
> ifFalse:[^interpreterProxy primitiveFail].
> bmFill := self allocateBitmapFill: cmSize colormap: cmBits.
> engineStopped ifTrue:[^nil].
> self bitmapWidthOf: bmFill put: bmWidth.
> self bitmapHeightOf: bmFill put: bmHeight.
> self bitmapDepthOf: bmFill put: bmDepth.
> self bitmapRasterOf: bmFill put: bmRaster.
> self bitmapSizeOf: bmFill put: bmBitsSize.
> self bitmapTileFlagOf: bmFill put: tileFlag.
> self objectIndexOf: bmFill put: xIndex.
> self loadFillOrientation: bmFill
> from: point1 along: point2 normal: point3
> width: bmWidth height: bmHeight.
> ^bmFill!
>
> Item was changed:
> ----- Method: CameraPlugin>>primGetFrame (in category 'primitives') -----
> primGetFrame
> "Copy a camera frame into the given Bitmap. The Bitmap should be
> for a Form of depth 32 that is the same width and height as the current
> camera frame. Fail if the camera is not open or if the bitmap is not the
> right size. If successful, answer the number of frames received from the
> camera since the last call. If this is zero, then there has been no change."
>
> | cameraNum bitmapOop bitmap pixCount result |
> <export: true>
> + <var: 'bitmap' type: #'unsigned char *'>
> - <var: 'bitmap' declareC: 'unsigned char *bitmap'>
>
> cameraNum := interpreterProxy stackIntegerValue: 1.
> bitmapOop := interpreterProxy stackValue: 0.
> + interpreterProxy success: (interpreterProxy isWords: bitmapOop).
> + interpreterProxy failed ifTrue:
> + [^ 0].
> + bitmap := self cCoerce: (interpreterProxy firstIndexableField:
> bitmapOop) to: #'unsigned char *'.
> - ((interpreterProxy isIntegerObject: bitmapOop) or:
> - [(interpreterProxy isWords: bitmapOop) not]) ifTrue: [
> - interpreterProxy success: false.
> - ^ 0].
> - bitmap := self cCoerce: (interpreterProxy firstIndexableField:
> bitmapOop) to: 'unsigned char *'.
> pixCount := interpreterProxy stSizeOf: bitmapOop.
>
> + result := self Camera: cameraNum Get: bitmap Frame: pixCount.
> - result := self cCode: 'CameraGetFrame(cameraNum, bitmap,
> pixCount)'.
> result < 0 ifTrue: [
> interpreterProxy success: false.
> ^ 0].
>
> interpreterProxy pop: 3 thenPush: (interpreterProxy
> integerObjectOf: result). "pop rcvr & args, push int result"
> ^ 0
>
> !
>
> Item was changed:
> ----- Method: CoInterpreter>>markAndTraceStackPage: (in category 'object
> memory support') -----
> markAndTraceStackPage: thePage
> | theSP theFP frameRcvrOffset callerFP oop |
> <var: #thePage type: #'StackPage *'>
> <var: #theSP type: #'char *'>
> <var: #theFP type: #'char *'>
> <var: #frameRcvrOffset type: #'char *'>
> <var: #callerFP type: #'char *'>
> <inline: false>
>
> self assert: (stackPages isFree: thePage) not.
> self assert: thePage trace ~= StackPageTraced.
> thePage trace: StackPageTraced.
>
> theSP := thePage headSP.
> theFP := thePage headFP.
> "Skip the instruction pointer on top of stack of inactive pages."
> thePage = stackPage ifFalse:
> [theSP := theSP + BytesPerWord].
> [frameRcvrOffset := self frameReceiverOffset: theFP.
> [theSP <= frameRcvrOffset] whileTrue:
> [oop := stackPages longAt: theSP.
> + (objectMemory isOopForwarded: oop) ifTrue:
> + [oop := objectMemory followForwarded: oop.
> + stackPages longAt: theSP put: oop].
> (objectMemory isImmediate: oop) ifFalse:
> [objectMemory markAndTrace: oop].
> theSP := theSP + BytesPerWord].
> (self frameHasContext: theFP) ifTrue:
> [self assert: (objectMemory isContext: (self frameContext:
> theFP)).
> objectMemory markAndTrace: (self frameContext: theFP)].
> (self isMachineCodeFrame: theFP)
> ifTrue: [self markAndTraceMachineCodeMethod: (self
> mframeCogMethod: theFP)]
> ifFalse: [objectMemory markAndTrace: (self iframeMethod:
> theFP)].
> (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
> [theSP := theFP + FoxCallerSavedIP + BytesPerWord.
> theFP := callerFP].
> theSP := theFP + FoxCallerSavedIP + BytesPerWord. "caller ip is
> ceBaseReturnPC"
> [theSP <= thePage baseAddress] whileTrue:
> [oop := stackPages longAt: theSP.
> + (objectMemory isOopForwarded: oop) ifTrue:
> + [oop := objectMemory followForwarded: oop.
> + stackPages longAt: theSP put: oop].
> (objectMemory isImmediate: oop) ifFalse:
> [objectMemory markAndTrace: oop].
> theSP := theSP + BytesPerWord]!
>
> Item was changed:
> ----- Method: DeflatePlugin>>loadDeflateStreamFrom: (in category
> 'primitive support') -----
> loadDeflateStreamFrom: rcvr
> | oop |
> <inline: false>
> + ((interpreterProxy isPointers: rcvr)
> + and: [(interpreterProxy slotSizeOf: rcvr) >= 15]) ifFalse:
> + [^false].
> - ((interpreterProxy isPointers: rcvr) and:[
> - (interpreterProxy slotSizeOf: rcvr) >= 15])
> ifFalse:[^false].
> oop := interpreterProxy fetchPointer: 0 ofObject: rcvr.
> + (interpreterProxy isBytes: oop) ifFalse:
> + [^false].
> - (interpreterProxy isIntegerObject: oop)
> - ifTrue:[^false].
> - (interpreterProxy isBytes: oop)
> - ifFalse:[^false].
> zipCollection := interpreterProxy firstIndexableField: oop.
> zipCollectionSize := interpreterProxy byteSizeOf: oop.
>
> zipPosition := interpreterProxy fetchInteger: 1 ofObject: rcvr.
> zipReadLimit := interpreterProxy fetchInteger: 2 ofObject: rcvr.
> "zipWriteLimit := interpreterProxy fetchInteger: 3 ofObject: rcvr."
>
> oop := interpreterProxy fetchPointer: 4 ofObject: rcvr.
> + ((interpreterProxy isWords: oop)
> + and: [(interpreterProxy slotSizeOf: oop) = DeflateHashTableSize])
> ifFalse:
> + [^false].
> - ((interpreterProxy isIntegerObject: oop) or:[
> - (interpreterProxy isWords: oop) not]) ifTrue:[^false].
> - (interpreterProxy slotSizeOf: oop) = DeflateHashTableSize
> ifFalse:[^false].
> zipHashHead := interpreterProxy firstIndexableField: oop.
> oop := interpreterProxy fetchPointer: 5 ofObject: rcvr.
> + ((interpreterProxy isWords: oop)
> + and: [(interpreterProxy slotSizeOf: oop) = DeflateWindowSize])
> ifFalse:
> + [^false].
> - ((interpreterProxy isIntegerObject: oop) or:[
> - (interpreterProxy isWords: oop) not]) ifTrue:[^false].
> - (interpreterProxy slotSizeOf: oop) = DeflateWindowSize
> ifFalse:[^false].
> zipHashTail := interpreterProxy firstIndexableField: oop.
> zipHashValue := interpreterProxy fetchInteger: 6 ofObject: rcvr.
> zipBlockPos := interpreterProxy fetchInteger: 7 ofObject: rcvr.
> "zipBlockStart := interpreterProxy fetchInteger: 8 ofObject: rcvr."
> oop := interpreterProxy fetchPointer: 9 ofObject: rcvr.
> + (interpreterProxy isBytes: oop) ifFalse:
> + [^false].
> - ((interpreterProxy isIntegerObject: oop) or:[
> - (interpreterProxy isBytes: oop) not]) ifTrue:[^false].
> zipLiteralSize := interpreterProxy slotSizeOf: oop.
> zipLiterals := interpreterProxy firstIndexableField: oop.
>
> oop := interpreterProxy fetchPointer: 10 ofObject: rcvr.
> + ((interpreterProxy isWords: oop)
> + and: [(interpreterProxy slotSizeOf: oop) >= zipLiteralSize])
> ifFalse:
> + [^false].
> - ((interpreterProxy isIntegerObject: oop) or:[
> - (interpreterProxy isWords: oop) not]) ifTrue:[^false].
> - (interpreterProxy slotSizeOf: oop) < zipLiteralSize
> ifTrue:[^false].
> zipDistances := interpreterProxy firstIndexableField: oop.
>
> oop := interpreterProxy fetchPointer: 11 ofObject: rcvr.
> + ((interpreterProxy isWords: oop)
> + and: [(interpreterProxy slotSizeOf: oop) =
> DeflateMaxLiteralCodes]) ifFalse:
> + [^false].
> - ((interpreterProxy isIntegerObject: oop) or:[
> - (interpreterProxy isWords: oop) not]) ifTrue:[^false].
> - (interpreterProxy slotSizeOf: oop) = DeflateMaxLiteralCodes
> ifFalse:[^false].
> zipLiteralFreq := interpreterProxy firstIndexableField: oop.
>
> oop := interpreterProxy fetchPointer: 12 ofObject: rcvr.
> + ((interpreterProxy isWords: oop)
> + and: [(interpreterProxy slotSizeOf: oop) =
> DeflateMaxDistanceCodes]) ifFalse:
> + [^false].
> - ((interpreterProxy isIntegerObject: oop) or:[
> - (interpreterProxy isWords: oop) not]) ifTrue:[^false].
> - (interpreterProxy slotSizeOf: oop) = DeflateMaxDistanceCodes
> ifFalse:[^false].
> zipDistanceFreq := interpreterProxy firstIndexableField: oop.
>
> zipLiteralCount := interpreterProxy fetchInteger: 13 ofObject:
> rcvr.
> zipMatchCount := interpreterProxy fetchInteger: 14 ofObject: rcvr.
>
> ^interpreterProxy failed not!
>
> Item was changed:
> ----- Method: DeflatePlugin>>loadZipEncoderFrom: (in category 'primitive
> support') -----
> loadZipEncoderFrom: rcvr
> | oop |
> <inline: false>
> + ((interpreterProxy isPointers: rcvr)
> + and: [(interpreterProxy slotSizeOf: rcvr) >= 6]) ifFalse:
> + [^false].
> - ((interpreterProxy isPointers: rcvr) and:[
> - (interpreterProxy slotSizeOf: rcvr) >= 6])
> ifFalse:[^false].
> oop := interpreterProxy fetchPointer: 0 ofObject: rcvr.
> + (interpreterProxy isBytes: oop) ifFalse:
> + [^interpreterProxy primitiveFail].
> - (interpreterProxy isIntegerObject: oop)
> - ifTrue:[^interpreterProxy primitiveFail].
> - (interpreterProxy isBytes: oop)
> - ifFalse:[^interpreterProxy primitiveFail].
> zipCollection := interpreterProxy firstIndexableField: oop.
> zipCollectionSize := interpreterProxy byteSizeOf: oop.
>
> zipPosition := interpreterProxy fetchInteger: 1 ofObject: rcvr.
> zipReadLimit := interpreterProxy fetchInteger: 2 ofObject: rcvr.
> "zipWriteLimit := interpreterProxy fetchInteger: 3 ofObject: rcvr."
> zipBitBuf := interpreterProxy fetchInteger: 4 ofObject: rcvr.
> zipBitPos := interpreterProxy fetchInteger: 5 ofObject: rcvr.
>
> ^interpreterProxy failed not!
>
> Item was changed:
> ----- Method: DeflatePlugin>>sendBlock:with:with:with: (in category
> 'encoding') -----
> sendBlock: literalStream with: distanceStream with: litTree with:
> distTree
> "Require:
> zipCollection, zipCollectionSize, zipPosition,
> zipBitBuf, zipBitPos.
> "
> | oop litPos litLimit litArray distArray lit dist sum llBitLengths
> llCodes distBitLengths distCodes code extra litBlCount distBlCount |
> + <var: #litArray type: #'unsigned char *'>
> + <var: #distArray type: #'unsigned int *'>
> + <var: #llBitLengths type: #'unsigned int *'>
> + <var: #llCodes type: #'unsigned int *'>
> + <var: #distBitLengths type: #'unsigned int *'>
> + <var: #distCodes type: #'unsigned int *'>
> - <var: #litArray type:'unsigned char *'>
> - <var: #distArray type:'unsigned int *'>
> - <var: #llBitLengths type:'unsigned int *'>
> - <var: #llCodes type:'unsigned int *'>
> - <var: #distBitLengths type:'unsigned int *'>
> - <var: #distCodes type:'unsigned int *'>
> oop := interpreterProxy fetchPointer: 0 ofObject: literalStream.
> litPos := interpreterProxy fetchInteger: 1 ofObject: literalStream.
> litLimit := interpreterProxy fetchInteger: 2 ofObject:
> literalStream.
> + (litPos <= litLimit
> + and: [(interpreterProxy isBytes: oop)
> + and: [litLimit <= (interpreterProxy byteSizeOf: oop)]]) ifFalse:
> + [^interpreterProxy primitiveFail].
> - ((interpreterProxy isIntegerObject: oop) not and:[litPos <=
> litLimit and:[
> - litLimit <= (interpreterProxy byteSizeOf: oop)
> and:[interpreterProxy isBytes: oop]]])
> - ifFalse:[^interpreterProxy primitiveFail].
> litArray := interpreterProxy firstIndexableField: oop.
>
> oop := interpreterProxy fetchPointer: 0 ofObject: distanceStream.
> + ((interpreterProxy isWords: oop)
> + and: [litLimit <= (interpreterProxy slotSizeOf: oop)
> + and: [(interpreterProxy fetchInteger: 1 ofObject: distanceStream)
> = litPos
> + and: [(interpreterProxy fetchInteger: 2 ofObject: distanceStream)
> = litLimit]]]) ifFalse:
> + [^interpreterProxy primitiveFail].
> - ((interpreterProxy isIntegerObject: oop) not and:[
> - (interpreterProxy fetchInteger: 1 ofObject:
> distanceStream) = litPos and:[
> - (interpreterProxy fetchInteger: 2 ofObject:
> distanceStream) = litLimit]])
> - ifFalse:[^interpreterProxy primitiveFail].
> - ((interpreterProxy isWords: oop) and:[
> - litLimit <= (interpreterProxy slotSizeOf: oop)])
> - ifFalse:[^interpreterProxy primitiveFail].
> distArray := interpreterProxy firstIndexableField: oop.
>
> oop := interpreterProxy fetchPointer: 0 ofObject: litTree.
> + (interpreterProxy isWords: oop) ifFalse:
> + [^interpreterProxy primitiveFail].
> - ((interpreterProxy isIntegerObject: oop) not and:[interpreterProxy
> isWords: oop])
> - ifFalse:[^interpreterProxy primitiveFail].
> litBlCount := interpreterProxy slotSizeOf: oop.
> llBitLengths := interpreterProxy firstIndexableField: oop.
>
> oop := interpreterProxy fetchPointer: 1 ofObject: litTree.
> + ((interpreterProxy isWords: oop)
> + and: [litBlCount = (interpreterProxy slotSizeOf: oop)]) ifFalse:
> + [^interpreterProxy primitiveFail].
> - ((interpreterProxy isIntegerObject: oop) not and:[interpreterProxy
> isWords: oop])
> - ifFalse:[^interpreterProxy primitiveFail].
> - (litBlCount = (interpreterProxy slotSizeOf: oop))
> - ifFalse:[^interpreterProxy primitiveFail].
> llCodes := interpreterProxy firstIndexableField: oop.
>
> oop := interpreterProxy fetchPointer: 0 ofObject: distTree.
> + (interpreterProxy isWords: oop) ifFalse:
> + [^interpreterProxy primitiveFail].
> - ((interpreterProxy isIntegerObject: oop) not and:[interpreterProxy
> isWords: oop])
> - ifFalse:[^interpreterProxy primitiveFail].
> distBlCount := interpreterProxy slotSizeOf: oop.
> distBitLengths := interpreterProxy firstIndexableField: oop.
>
> oop := interpreterProxy fetchPointer: 1 ofObject: distTree.
> + ((interpreterProxy isWords: oop)
> + and: [distBlCount = (interpreterProxy slotSizeOf: oop)]) ifFalse:
> + [^interpreterProxy primitiveFail].
> - ((interpreterProxy isIntegerObject: oop) not and:[interpreterProxy
> isWords: oop])
> - ifFalse:[^interpreterProxy primitiveFail].
> - (distBlCount = (interpreterProxy slotSizeOf: oop))
> - ifFalse:[^interpreterProxy primitiveFail].
> distCodes := interpreterProxy firstIndexableField: oop.
>
> - interpreterProxy failed ifTrue:[^nil].
> -
> self nextZipBits: 0 put: 0. "Flush pending bits if necessary"
> sum := 0.
> [litPos < litLimit and:[zipPosition + 4 < zipCollectionSize]]
> whileTrue:[
> lit := litArray at: litPos.
> dist := distArray at: litPos.
> litPos := litPos + 1.
> dist = 0 ifTrue:["literal"
> sum := sum + 1.
> lit < litBlCount ifFalse:[^interpreterProxy
> primitiveFail].
> self nextZipBits: (llBitLengths at: lit) put:
> (llCodes at: lit).
> ] ifFalse:["match"
> sum := sum + lit + DeflateMinMatch.
> lit < 256 ifFalse:[^interpreterProxy
> primitiveFail].
> code := zipMatchLengthCodes at: lit.
> code < litBlCount ifFalse:[^interpreterProxy
> primitiveFail].
> self nextZipBits: (llBitLengths at: code) put:
> (llCodes at: code).
> extra := zipExtraLengthBits at: code - 257.
> extra = 0 ifFalse:[
> lit := lit - (zipBaseLength at: code -
> 257).
> self nextZipBits: extra put: lit].
> dist := dist - 1.
> dist < 16r8000 ifFalse:[^interpreterProxy
> primitiveFail].
> dist < 256
> ifTrue:[code := zipDistanceCodes at: dist]
> ifFalse:[code := zipDistanceCodes at: 256
> + (dist >> 7)].
> code < distBlCount ifFalse:[^interpreterProxy
> primitiveFail].
> self nextZipBits: (distBitLengths at: code) put:
> (distCodes at: code).
> extra := zipExtraDistanceBits at: code.
> extra = 0 ifFalse:[
> dist := dist - (zipBaseDistance at: code).
> self nextZipBits: extra put: dist].
> ].
> ].
> interpreterProxy failed ifTrue:[^nil].
> interpreterProxy storeInteger: 1 ofObject: literalStream
> withValue: litPos.
> interpreterProxy storeInteger: 1 ofObject: distanceStream
> withValue: litPos.
> ^sum!
>
> Item was changed:
> ----- Method: FFIPlugin>>ffiArgument:Spec:Class: (in category 'callout
> support') -----
> ffiArgument: oop Spec: argSpec Class: argClass
> "Callout support. Prepare the given oop as argument.
> argSpec defines the compiled spec for the argument.
> argClass (if non-nil) defines the required (super)class for the
> argument."
> | valueOop oopClass isStruct nilOop |
> <inline: false>
> oopClass := interpreterProxy fetchClassOf: oop. "Prefetch class
> (we'll need it)"
> nilOop := interpreterProxy nilObject.
> "Do the necessary type checks"
> argClass == nilOop ifFalse:[
> "Type check 1:
> Is the required class of the argument a subclass of
> ExternalStructure?"
> (interpreterProxy includesBehavior: argClass
> ThatOf: interpreterProxy
> classExternalStructure)
> ifFalse:[^self ffiFail: FFIErrorWrongType]. "Nope.
> Fail."
> "Type check 2:
> Is the class of the argument a subclass of required class?"
> ((nilOop == oop) or:[interpreterProxy includesBehavior:
> oopClass ThatOf: argClass])
> ifFalse:[^self ffiFail:
> FFIErrorCoercionFailed]. "Nope. Fail."
> "Okay, we've passed the type check (so far)"
> ].
>
> "Check if oopClass is a subclass of ExternalStructure.
> If this is the case we'll work on it's handle and not the actual
> oop."
> isStruct := false.
> + ((interpreterProxy isImmediate: oop) or:[oop == nilOop]) ifFalse:[
> + "#isPointers: will fail if oop is immediate so don't even
> attempt to use it"
> - ((interpreterProxy isIntegerObject: oop) or:[oop == nilOop])
> ifFalse:[
> - "#isPointers: will fail if oop is SmallInteger so don't
> even attempt to use it"
> (interpreterProxy isPointers: oop)
> ifTrue:[isStruct := interpreterProxy
> includesBehavior: oopClass
> ThatOf:
> interpreterProxy classExternalStructure.
> (argClass == nilOop or:[isStruct])
> ifFalse:[^self ffiFail:
> FFIErrorCoercionFailed]].
> "note: the test for #isPointers: above should speed up
> execution since no pointer type ST objects are allowed in external calls
> and thus if #isPointers: is true then the arg must be ExternalStructure to
> work. If it isn't then the code fails anyways so speed isn't an issue"
> ].
>
> "Determine valueOop (e.g., the actual oop to pass as argument)"
> isStruct
> ifTrue:[valueOop := interpreterProxy fetchPointer: 0
> ofObject: oop]
> ifFalse:[valueOop := oop].
>
> "Fetch and check the contents of the compiled spec"
> - (interpreterProxy isIntegerObject: argSpec)
> - ifTrue:[self ffiFail: FFIErrorWrongType. ^nil].
> (interpreterProxy isWords: argSpec)
> ifFalse:[self ffiFail: FFIErrorWrongType. ^nil].
> ffiArgSpecSize := interpreterProxy slotSizeOf: argSpec.
> ffiArgSpecSize = 0 ifTrue:[self ffiFail: FFIErrorWrongType. ^nil].
> ffiArgSpec := self cCoerce: (interpreterProxy firstIndexableField:
> argSpec) to: 'int'.
> ffiArgHeader := interpreterProxy longAt: ffiArgSpec.
>
> "Do the actual preparation of the argument"
> "Note: Order is important since FFIFlagStructure + FFIFlagPointer
> is used to represent 'typedef void* VoidPointer' and VoidPointer really is
> *struct* not pointer."
>
> (ffiArgHeader anyMask: FFIFlagStructure) ifTrue:[
> "argument must be ExternalStructure"
> isStruct ifFalse:[^self ffiFail: FFIErrorCoercionFailed].
> (ffiArgHeader anyMask: FFIFlagAtomic)
> ifTrue:[^self ffiFail: FFIErrorWrongType]. "bad
> combination"
> ^self ffiPushStructureContentsOf: valueOop].
>
> (ffiArgHeader anyMask: FFIFlagPointer) ifTrue:[
> + "no integers (or characters) for pointers please"
> + (interpreterProxy isImmediate: oop)
> - "no integers for pointers please"
> - (interpreterProxy isIntegerObject: oop)
> ifTrue:[^self ffiFail: FFIErrorIntAsPointer].
>
> "but allow passing nil pointer for any pointer type"
> oop == interpreterProxy nilObject ifTrue:[^self
> ffiPushPointer: nil].
>
> "argument is reference to either atomic or structure type"
> (ffiArgHeader anyMask: FFIFlagAtomic) ifTrue:[
> isStruct "e.g., ExternalData"
> ifTrue:[^self ffiAtomicStructByReference:
> oop Class: oopClass]
> ifFalse:[^self ffiAtomicArgByReference:
> oop Class: oopClass].
> "********* NOTE: The above uses 'oop' not
> 'valueOop' (for ExternalData) ******"
> ].
>
> "Needs to be external structure here"
> isStruct ifFalse:[^self ffiFail: FFIErrorCoercionFailed].
> ^self ffiPushPointerContentsOf: valueOop].
>
> (ffiArgHeader anyMask: FFIFlagAtomic) ifTrue:[
> "argument is atomic value"
> self ffiArgByValue: valueOop.
> ^0].
> "None of the above - bad spec"
> ^self ffiFail: FFIErrorWrongType!
>
> Item was changed:
> ----- Method: FFIPlugin>>ffiCheckReturn:With: (in category 'callout
> support') -----
> ffiCheckReturn: retSpec With: retClass
> "Make sure we can return an object of the given type"
> <inline: true>
> retClass == interpreterProxy nilObject ifFalse:[
> (interpreterProxy includesBehavior: retClass
> ThatOf: interpreterProxy
> classExternalStructure)
> ifFalse:[^self ffiFail: FFIErrorBadReturn]].
> ffiRetClass := retClass.
>
> - (interpreterProxy isIntegerObject: retSpec)
> - ifTrue:[self ffiFail: FFIErrorWrongType. ^nil].
> (interpreterProxy isWords: retSpec)
> ifFalse:[self ffiFail: FFIErrorWrongType. ^nil].
> ffiRetSpecSize := interpreterProxy slotSizeOf: retSpec.
> ffiRetSpecSize = 0 ifTrue:[self ffiFail: FFIErrorWrongType. ^nil].
> ffiRetSpec := self cCoerce: (interpreterProxy firstIndexableField:
> retSpec) to: 'int'.
> ffiRetHeader := interpreterProxy longAt: ffiRetSpec.
> (self isAtomicType: ffiRetHeader) ifFalse:[
> (ffiRetClass == interpreterProxy nilObject)
> ifTrue:[^self ffiFail: FFIErrorBadReturn]].
> (self ffiCan: (self cCoerce: ffiRetSpec to:'int*') Return:
> ffiRetSpecSize)
> ifFalse:[self ffiFail: FFIErrorBadReturn]. "cannot return
> this type"
> ^0!
>
> Item was changed:
> ----- Method: FFIPlugin>>ffiContentsOfHandle:errCode: (in category
> 'callout support') -----
> ffiContentsOfHandle: oop errCode: errCode
> "Make sure that the given oop is a valid external handle"
> <inline: true>
> - (interpreterProxy isIntegerObject: oop)
> - ifTrue:[^self ffiFail: errCode].
> (interpreterProxy isBytes: oop)
> ifFalse:[^self ffiFail: errCode].
> ((interpreterProxy byteSizeOf: oop) == 4)
> ifFalse:[^self ffiFail: errCode].
> ^interpreterProxy fetchPointer: 0 ofObject: oop!
>
> Item was changed:
> ----- Method: FFIPlugin>>ffiIntegerValueOf: (in category 'callout
> support') -----
> ffiIntegerValueOf: oop
> "Support for generic callout. Return an integer value that is
> coerced as C would do."
> | oopClass |
> <inline: true>
> (interpreterProxy isIntegerObject: oop) ifTrue:[^interpreterProxy
> integerValueOf: oop].
> oop == interpreterProxy nilObject ifTrue:[^0]. "@@: should we
> really allow this????"
> oop == interpreterProxy falseObject ifTrue:[^0].
> oop == interpreterProxy trueObject ifTrue:[^1].
> oopClass := interpreterProxy fetchClassOf: oop.
> oopClass == interpreterProxy classFloat
> ifTrue:[^(interpreterProxy floatValueOf: oop) asInteger].
> oopClass == interpreterProxy classCharacter
> + ifTrue:[^interpreterProxy characterValueOf: oop].
> - ifTrue:[^interpreterProxy fetchInteger: 0 ofObject: oop].
> oopClass == interpreterProxy classLargePositiveInteger
> ifTrue:[^interpreterProxy positive32BitValueOf: oop].
> ^interpreterProxy signed32BitValueOf: oop "<- will fail if not
> integer"!
>
> Item was changed:
> ----- Method: FFIPlugin>>ffiValidateExternalData:AtomicType: (in
> category 'callout support') -----
> ffiValidateExternalData: oop AtomicType: atomicType
> "Validate if the given oop (an instance of ExternalData) can be
> passed as a pointer to the given atomic type."
> | ptrType specOop spec specType |
> <inline: true>
> ptrType := interpreterProxy fetchPointer: 1 ofObject: oop.
> - (interpreterProxy isIntegerObject: ptrType)
> - ifTrue:[^self ffiFail: FFIErrorWrongType].
> (interpreterProxy isPointers: ptrType)
> ifFalse:[^self ffiFail: FFIErrorWrongType].
> (interpreterProxy slotSizeOf: ptrType) < 2
> ifTrue:[^self ffiFail: FFIErrorWrongType].
> specOop := interpreterProxy fetchPointer: 0 ofObject: ptrType.
> - (interpreterProxy isIntegerObject: specOop)
> - ifTrue:[^self ffiFail: FFIErrorWrongType].
> (interpreterProxy isWords: specOop)
> ifFalse:[^self ffiFail: FFIErrorWrongType].
> (interpreterProxy slotSizeOf: specOop) = 0
> ifTrue:[^self ffiFail: FFIErrorWrongType].
> spec := interpreterProxy fetchPointer: 0 ofObject: specOop.
> (self isAtomicType: spec)
> ifFalse:[^self ffiFail: FFIErrorWrongType].
> specType := self atomicTypeOf: spec.
> specType ~= atomicType ifTrue:[
> "allow for signed/unsigned conversion but nothing else"
> (atomicType > FFITypeBool and:[atomicType <
> FFITypeSingleFloat])
> ifFalse:[^self ffiFail: FFIErrorCoercionFailed].
> ((atomicType >> 1) = (specType >> 1))
> ifFalse:[^self ffiFail: FFIErrorCoercionFailed]].
> ^0!
>
> Item was changed:
> ----- Method: Interpreter>>primitiveFormPrint (in category 'I/O
> primitives') -----
> primitiveFormPrint
> "On platforms that support it, this primitive prints the receiver,
> assumed to be a Form, to the default printer."
>
> | landscapeFlag vScale hScale rcvr bitsArray w h
> depth pixelsPerWord wordsPerLine bitsArraySize ok |
>
> <var: #vScale type: 'double '>
> <var: #hScale type: 'double '>
> landscapeFlag := self booleanValueOf: self stackTop.
> vScale := self floatValueOf: (self stackValue: 1).
> hScale := self floatValueOf: (self stackValue: 2).
> rcvr := self stackValue: 3.
> (rcvr isIntegerObject: rcvr) ifTrue: [self success: false].
> successFlag ifTrue: [
> ((self isPointers: rcvr) and: [(self lengthOf: rcvr) >=
> 4])
> ifFalse: [self success: false]].
> successFlag ifTrue: [
> bitsArray := self fetchPointer: 0 ofObject: rcvr.
> w := self fetchInteger: 1 ofObject: rcvr.
> h := self fetchInteger: 2 ofObject: rcvr.
> depth := self fetchInteger: 3 ofObject: rcvr.
> (w > 0 and: [h > 0]) ifFalse: [self success: false].
> pixelsPerWord := 32 // depth.
> wordsPerLine := (w + (pixelsPerWord - 1)) // pixelsPerWord.
> ((rcvr isIntegerObject: rcvr) not and: [self
> isWordsOrBytes: bitsArray])
> ifTrue: [
> bitsArraySize := self byteLengthOf:
> bitsArray.
> self success: (bitsArraySize =
> (wordsPerLine * h * 4))]
> ifFalse: [self success: false]].
> successFlag ifTrue: [
> + ok := self cCode: 'ioFormPrint(bitsArray + BaseHeaderSize,
> w, h, depth, hScale, vScale, landscapeFlag)'.
> - BytesPerWord = 8
> - ifTrue: [ok := self cCode: 'ioFormPrint(bitsArray
> + 8, w, h, depth, hScale, vScale, landscapeFlag)']
> - ifFalse: [ok := self cCode: 'ioFormPrint(bitsArray
> + 4, w, h, depth, hScale, vScale, landscapeFlag)'].
> self success: ok].
> successFlag ifTrue: [
> self pop: 3]. "pop hScale, vScale, and landscapeFlag;
> leave rcvr on stack"
> !
>
> Item was changed:
> ----- Method: InterpreterPrimitives>>primitiveFormPrint (in category
> 'I/O primitives') -----
> primitiveFormPrint
> "On platforms that support it, this primitive prints the receiver,
> assumed to be a Form, to the default printer."
>
> | landscapeFlag vScale hScale rcvr bitsArray w h
> depth pixelsPerWord wordsPerLine bitsArraySize ok |
>
> <var: #vScale type: 'double '>
> <var: #hScale type: 'double '>
> landscapeFlag := self booleanValueOf: self stackTop.
> vScale := self floatValueOf: (self stackValue: 1).
> hScale := self floatValueOf: (self stackValue: 2).
> rcvr := self stackValue: 3.
> + ((objectMemory isPointers: rcvr)
> + and: [(objectMemory lengthOf: rcvr) >= 4]) ifFalse:
> + [self success: false].
> + self successful ifTrue:
> + [bitsArray := objectMemory fetchPointer: 0 ofObject: rcvr.
> - (rcvr isIntegerObject: rcvr) ifTrue: [self success: false].
> - self successful ifTrue: [
> - ((objectMemory isPointers: rcvr) and: [(objectMemory
> lengthOf: rcvr) >= 4])
> - ifFalse: [self success: false]].
> - self successful ifTrue: [
> - bitsArray := objectMemory fetchPointer: 0 ofObject: rcvr.
> w := self fetchInteger: 1 ofObject: rcvr.
> h := self fetchInteger: 2 ofObject: rcvr.
> depth := self fetchInteger: 3 ofObject: rcvr.
> (w > 0 and: [h > 0]) ifFalse: [self success: false].
> pixelsPerWord := 32 // depth.
> wordsPerLine := (w + (pixelsPerWord - 1)) // pixelsPerWord.
> + (objectMemory isWordsOrBytes: bitsArray)
> + ifTrue:
> + [bitsArraySize := objectMemory
> byteLengthOf: bitsArray.
> - ((rcvr isIntegerObject: rcvr) not and: [objectMemory
> isWordsOrBytes: bitsArray])
> - ifTrue: [
> - bitsArraySize := objectMemory
> byteLengthOf: bitsArray.
> self success: (bitsArraySize =
> (wordsPerLine * h * 4))]
> ifFalse: [self success: false]].
> + self successful ifTrue:
> + [ok := self cCode: 'ioFormPrint(bitsArray +
> BaseHeaderSize, w, h, depth, hScale, vScale, landscapeFlag)'.
> - self successful ifTrue: [
> - BytesPerWord = 8
> - ifTrue: [ok := self cCode: 'ioFormPrint(bitsArray
> + 8, w, h, depth, hScale, vScale, landscapeFlag)']
> - ifFalse: [ok := self cCode: 'ioFormPrint(bitsArray
> + 4, w, h, depth, hScale, vScale, landscapeFlag)'].
> self success: ok].
> + self successful ifTrue:
> + [self pop: 3] "pop hScale, vScale, and landscapeFlag;
> leave rcvr on stack"!
> - self successful ifTrue: [
> - self pop: 3]. "pop hScale, vScale, and landscapeFlag;
> leave rcvr on stack"!
>
> Item was changed:
> ----- Method: InterpreterProxy>>isArray: (in category 'testing') -----
> isArray: oop
> + ^(self isNonImmediate: oop) and: [oop class instSpec = 2]!
> - ^(self isIntegerObject: oop) not and:[(oop class format bitAnd:
> 15) = 2]
> - !
>
> Item was changed:
> ----- Method: InterpreterProxy>>stackObjectValue: (in category 'stack
> access') -----
> stackObjectValue: offset
> | oop |
> oop := self stackValue: offset.
> + (self isImmediate: oop) ifTrue: [self primitiveFail. ^ nil].
> - (self isIntegerObject: oop) ifTrue: [self primitiveFail. ^ nil].
> ^oop!
>
> Item was changed:
> ----- Method: JPEGReaderPlugin>>colorComponent:from: (in category
> 'decoding') -----
> colorComponent: aColorComponent from: oop
> <var: #aColorComponent type: 'int *'>
> - (interpreterProxy isIntegerObject: oop) ifTrue:[^false].
> (interpreterProxy isPointers: oop) ifFalse:[^false].
> (interpreterProxy slotSizeOf: oop) < MinComponentSize
> ifTrue:[^false].
> aColorComponent at: CurrentXIndex put:
> (interpreterProxy fetchInteger: CurrentXIndex ofObject:
> oop).
> aColorComponent at: CurrentYIndex put:
> (interpreterProxy fetchInteger: CurrentYIndex ofObject:
> oop).
> aColorComponent at: HScaleIndex put:
> (interpreterProxy fetchInteger: HScaleIndex ofObject: oop).
> aColorComponent at: VScaleIndex put:
> (interpreterProxy fetchInteger: VScaleIndex ofObject: oop).
> aColorComponent at: BlockWidthIndex put:
> (interpreterProxy fetchInteger: BlockWidthIndex ofObject:
> oop).
> aColorComponent at: MCUWidthIndex put:
> (interpreterProxy fetchInteger: MCUWidthIndex ofObject:
> oop).
> aColorComponent at: PriorDCValueIndex put:
> (interpreterProxy fetchInteger: PriorDCValueIndex
> ofObject: oop).
> ^interpreterProxy failed not!
>
> Item was changed:
> ----- Method: JPEGReaderPlugin>>colorComponentBlocks:from: (in category
> 'decoding') -----
> colorComponentBlocks: blocks from: oop
> | arrayOop max blockOop |
> <var: #blocks type: 'int **'>
> - (interpreterProxy isIntegerObject: oop) ifTrue:[^false].
> (interpreterProxy isPointers: oop) ifFalse:[^false].
> (interpreterProxy slotSizeOf: oop) < MinComponentSize
> ifTrue:[^false].
>
> arrayOop := interpreterProxy fetchPointer: MCUBlockIndex ofObject:
> oop.
> - (interpreterProxy isIntegerObject: arrayOop) ifTrue:[^false].
> (interpreterProxy isPointers: arrayOop) ifFalse:[^false].
> max := interpreterProxy slotSizeOf: arrayOop.
> max > MaxMCUBlocks ifTrue:[^false].
> 0 to: max-1 do:[:i|
> blockOop := interpreterProxy fetchPointer: i ofObject:
> arrayOop.
> - (interpreterProxy isIntegerObject: blockOop)
> ifTrue:[^false].
> (interpreterProxy isWords: blockOop) ifFalse:[^false].
> (interpreterProxy slotSizeOf: blockOop) = DCTSize2
> ifFalse:[^false].
> blocks at: i put: (interpreterProxy firstIndexableField:
> blockOop).
> ].
> ^interpreterProxy failed not!
>
> Item was changed:
> ----- Method: JPEGReaderPlugin>>loadJPEGStreamFrom: (in category 'stream
> support') -----
> loadJPEGStreamFrom: streamOop
> | oop sz |
> - (interpreterProxy slotSizeOf: streamOop) < 5 ifTrue:[^false].
> (interpreterProxy isPointers: streamOop) ifFalse:[^false].
> + (interpreterProxy slotSizeOf: streamOop) < 5 ifTrue:[^false].
> oop := interpreterProxy fetchPointer: 0 ofObject: streamOop.
> - (interpreterProxy isIntegerObject: oop) ifTrue:[^false].
> (interpreterProxy isBytes: oop) ifFalse:[^false].
> jsCollection := interpreterProxy firstIndexableField: oop.
> sz := interpreterProxy byteSizeOf: oop.
> jsPosition := interpreterProxy fetchInteger: 1 ofObject: streamOop.
> jsReadLimit := interpreterProxy fetchInteger: 2 ofObject:
> streamOop.
> jsBitBuffer := interpreterProxy fetchInteger: 3 ofObject:
> streamOop.
> jsBitCount := interpreterProxy fetchInteger: 4 ofObject: streamOop.
> interpreterProxy failed ifTrue:[^false].
> sz < jsReadLimit ifTrue:[^false].
> (jsPosition < 0 or:[jsPosition >= jsReadLimit]) ifTrue:[^false].
> ^true!
>
> Item was changed:
> ----- Method: NewspeakInterpreter>>primitiveFormPrint (in category 'I/O
> primitives') -----
> primitiveFormPrint
> "On platforms that support it, this primitive prints the receiver,
> assumed to be a Form, to the default printer."
>
> | landscapeFlag vScale hScale rcvr bitsArray w h
> depth pixelsPerWord wordsPerLine bitsArraySize ok |
>
> <var: #vScale type: 'double '>
> <var: #hScale type: 'double '>
> landscapeFlag := self booleanValueOf: self stackTop.
> vScale := self floatValueOf: (self stackValue: 1).
> hScale := self floatValueOf: (self stackValue: 2).
> rcvr := self stackValue: 3.
> (rcvr isIntegerObject: rcvr) ifTrue: [self success: false].
> self successful ifTrue: [
> ((self isPointers: rcvr) and: [(self lengthOf: rcvr) >=
> 4])
> ifFalse: [self success: false]].
> self successful ifTrue: [
> bitsArray := self fetchPointer: 0 ofObject: rcvr.
> w := self fetchInteger: 1 ofObject: rcvr.
> h := self fetchInteger: 2 ofObject: rcvr.
> depth := self fetchInteger: 3 ofObject: rcvr.
> (w > 0 and: [h > 0]) ifFalse: [self success: false].
> pixelsPerWord := 32 // depth.
> wordsPerLine := (w + (pixelsPerWord - 1)) // pixelsPerWord.
> ((rcvr isIntegerObject: rcvr) not and: [self
> isWordsOrBytes: bitsArray])
> ifTrue: [
> bitsArraySize := self byteLengthOf:
> bitsArray.
> self success: (bitsArraySize =
> (wordsPerLine * h * 4))]
> ifFalse: [self success: false]].
> self successful ifTrue: [
> + ok := self cCode: 'ioFormPrint(bitsArray + BaseHeaderSize,
> w, h, depth, hScale, vScale, landscapeFlag)'.
> - BytesPerWord = 8
> - ifTrue: [ok := self cCode: 'ioFormPrint(bitsArray
> + 8, w, h, depth, hScale, vScale, landscapeFlag)']
> - ifFalse: [ok := self cCode: 'ioFormPrint(bitsArray
> + 4, w, h, depth, hScale, vScale, landscapeFlag)'].
> self success: ok].
> self successful ifTrue: [
> self pop: 3]. "pop hScale, vScale, and landscapeFlag;
> leave rcvr on stack"
> !
>
> Item was changed:
> ----- Method: ScratchPlugin>>primOpenPortNamed (in category 'serial
> port') -----
> primOpenPortNamed
> "Open the port with the given name and baud rate."
>
> | nameStr src nameOop baudRate count portNum |
> <export: true>
> <var: 'nameStr' declareC: 'char nameStr[1000]'>
> + <var: 'src' type: #'char *'>
> - <var: 'src' declareC: 'char * src'>
>
> nameOop := interpreterProxy stackValue: 1.
> baudRate := interpreterProxy stackIntegerValue: 0.
>
> + interpreterProxy success: (interpreterProxy isBytes: nameOop).
> - ((interpreterProxy isIntegerObject: nameOop) or:
> - [(interpreterProxy isBytes: nameOop) not]) ifTrue: [
> - interpreterProxy success: false.
> - ^ 0].
>
> interpreterProxy failed ifTrue: [^ 0].
>
> + src := self cCoerce: (interpreterProxy firstIndexableField:
> nameOop) to: #'char *'.
> - src := self cCoerce: (interpreterProxy firstIndexableField:
> nameOop) to: 'char *'.
> count := interpreterProxy stSizeOf: nameOop.
> 0 to: count - 1 do: [:i | nameStr at: i put: (src at: i)].
> nameStr at: count put: 0.
>
> + portNum := self SerialPortOpen: nameStr PortNamed: baudRate.
> - portNum := self cCode: 'SerialPortOpenPortNamed(nameStr,
> baudRate)'.
> portNum = -1 ifTrue: [interpreterProxy success: false. ^ 0].
>
> interpreterProxy "pop args and rcvr, push result"
> pop: 3
> thenPush: (interpreterProxy integerObjectOf: portNum).
>
> ^ 0
> !
>
> Item was changed:
> ----- Method: ScratchPlugin>>primRead (in category 'serial port') -----
> primRead
> "Read data from the given serial port into the given buffer (a
> ByteArray or String). Answer the number of bytes read."
>
> + | portNum bufOop bytesRead |
> - | portNum bufOop bufPtr bufSize bytesRead |
> <export: true>
> - <var: 'bufPtr' declareC: 'char *bufPtr'>
>
> portNum := interpreterProxy stackIntegerValue: 1.
> bufOop := interpreterProxy stackValue: 0.
>
> + interpreterProxy success: (interpreterProxy isBytes: bufOop).
> + interpreterProxy failed ifTrue: [^ 0].
> - ((interpreterProxy isIntegerObject: bufOop) or:
> - [(interpreterProxy isBytes: bufOop) not]) ifTrue: [
> - interpreterProxy success: false.
> - ^ 0].
> - bufPtr := self cCoerce: (interpreterProxy firstIndexableField:
> bufOop) to: 'char *'.
> - bufSize := interpreterProxy stSizeOf: bufOop.
> - interpreterProxy failed ifTrue: [^ nil].
>
> + bytesRead := self Serial: portNum
> + Port: (self cCoerce:
> (interpreterProxy firstIndexableField: bufOop) to: 'char *')
> + Read: (interpreterProxy
> stSizeOf: bufOop).
> - bytesRead := self cCode: 'SerialPortRead(portNum, bufPtr,
> bufSize)'.
>
> interpreterProxy pop: 3.
> "pop args and rcvr"
> interpreterProxy pushInteger: bytesRead. "push result"
> + ^ 0!
> - ^ 0
> - !
>
> Item was changed:
> ----- Method: ScratchPlugin>>primWrite (in category 'serial port') -----
> primWrite
> "Write data to the given serial port from the given buffer (a
> ByteArray or String). Answer the number of bytes written."
>
> + | portNum bufOop bytesWritten |
> - | portNum bufOop bufPtr bufSize bytesWritten |
> <export: true>
> - <var: 'bufPtr' declareC: 'char *bufPtr'>
>
> portNum := interpreterProxy stackIntegerValue: 1.
> bufOop := interpreterProxy stackValue: 0.
>
> + interpreterProxy success: (interpreterProxy isBytes: bufOop).
> + interpreterProxy failed ifTrue: [^ 0].
> - ((interpreterProxy isIntegerObject: bufOop) or:
> - [(interpreterProxy isBytes: bufOop) not]) ifTrue: [
> - interpreterProxy success: false.
> - ^ 0].
> - bufPtr := self cCoerce: (interpreterProxy firstIndexableField:
> bufOop) to: 'char *'.
> - bufSize := interpreterProxy stSizeOf: bufOop.
> - interpreterProxy failed ifTrue: [^ nil].
>
> + bytesWritten := self Serial: portNum
> + Port: (self cCoerce:
> (interpreterProxy firstIndexableField: bufOop) to: 'char *')
> + Write: (interpreterProxy
> stSizeOf: bufOop).
> - bytesWritten := self cCode: 'SerialPortWrite(portNum, bufPtr,
> bufSize)'.
>
> + interpreterProxy pop: 3.
> "pop args and rcvr"
> - interpreterProxy pop: 3.
> "pop args and rcvr"
> interpreterProxy pushInteger: bytesWritten. "push result"
> + ^ 0!
> - ^ 0
> - !
>
> Item was changed:
> ----- Method: ScratchPlugin>>primitiveIsHidden (in category 'os
> functions') -----
> primitiveIsHidden
> "Answer true if the file or folder with the given path should be
> hidden from the user. On Windows, this is the value of the 'hidden' file
> property."
>
> | pathOop src count fullPath result |
> <export: true>
> <var: 'fullPath' declareC: 'char fullPath[1000]'>
> + <var: 'src' type: #'char *'>
> - <var: 'src' declareC: 'char * src'>
>
> pathOop := interpreterProxy stackValue: 0.
>
> + interpreterProxy success: (interpreterProxy isBytes: pathOop).
> - ((interpreterProxy isIntegerObject: pathOop) or:
> - [(interpreterProxy isBytes: pathOop) not]) ifTrue: [
> - interpreterProxy success: false].
>
> interpreterProxy failed ifTrue: [^ 0].
>
> + src := self cCoerce: (interpreterProxy firstIndexableField:
> pathOop) to: #'char *'.
> - src := self cCoerce: (interpreterProxy firstIndexableField:
> pathOop) to: 'char *'.
> count := interpreterProxy stSizeOf: pathOop.
> count >= 1000 ifTrue: [interpreterProxy success: false. ^ 0].
> 0 to: count - 1 do: [:i | fullPath at: i put: (src at: i)].
> fullPath at: count put: 0.
>
> + result := self IsFileOrFolderHidden: fullPath.
> - result := self cCode: 'IsFileOrFolderHidden(fullPath)'.
>
> interpreterProxy pop: 2. "pop arg and rcvr"
> interpreterProxy pushBool: result ~= 0. "push result"
> + ^ 0!
> - ^ 0
> -
> - !
>
> Item was changed:
> ----- Method: ScratchPlugin>>primitiveOpenURL (in category 'os
> functions') -----
> primitiveOpenURL
> "Open a web browser on the given URL."
>
> | urlStr src urlOop count |
> <export: true>
> <var: 'urlStr' declareC: 'char urlStr[2000]'>
> + <var: 'src' type: #'char *'>
> - <var: 'src' declareC: 'char * src'>
>
> urlOop := interpreterProxy stackValue: 0.
>
> + interpreterProxy success: (interpreterProxy isBytes: urlOop).
> - ((interpreterProxy isIntegerObject: urlOop) or:
> - [(interpreterProxy isBytes: urlOop) not]) ifTrue: [
> - interpreterProxy success: false].
>
> interpreterProxy failed ifTrue: [^ 0].
>
> + src := self cCoerce: (interpreterProxy firstIndexableField:
> urlOop) to: #'char *'.
> - src := self cCoerce: (interpreterProxy firstIndexableField:
> urlOop) to: 'char *'.
> count := interpreterProxy stSizeOf: urlOop.
> count >= 2000 ifTrue: [interpreterProxy success: false. ^ 0].
> 0 to: count - 1 do: [:i | urlStr at: i put: (src at: i)].
> urlStr at: count put: 0.
>
> + self OpenURL: urlStr.
> - self cCode: 'OpenURL(urlStr)'.
>
> interpreterProxy pop: 1. "pop arg, leave rcvr on stack"
> + ^ 0!
> - ^ 0
> -
> - !
>
> Item was changed:
> ----- Method: ScratchPlugin>>primitiveSetUnicodePasteBuffer (in category
> 'os functions') -----
> primitiveSetUnicodePasteBuffer
> "Set the Mac OS X Unicode paste buffer."
>
> | utf16 strOop count |
> <export: true>
> + <var: 'utf16' declareC: 'short *utf16'>
> - <var: 'utf16' declareC: 'short int *utf16'>
>
> strOop := interpreterProxy stackValue: 0.
>
> + interpreterProxy success: (interpreterProxy isBytes: strOop).
> - ((interpreterProxy isIntegerObject: strOop) or:
> - [(interpreterProxy isBytes: strOop) not]) ifTrue: [
> - interpreterProxy success: false].
>
> interpreterProxy failed ifTrue: [^ 0].
>
> + utf16 := self cCoerce: (interpreterProxy firstIndexableField:
> strOop) to: #'short *'.
> - utf16 := self cCoerce: (interpreterProxy firstIndexableField:
> strOop) to: 'short int *'.
> count := interpreterProxy stSizeOf: strOop.
>
> + self SetUnicodePaste: utf16 Buffer: count.
> - self cCode: 'SetUnicodePasteBuffer(utf16, count)'.
>
> interpreterProxy pop: 1. "pop arg, leave rcvr on stack"
> + ^ 0!
> - ^ 0
> -
> - !
>
> Item was changed:
> ----- Method: ScratchPlugin>>primitiveSetWindowTitle (in category 'os
> functions') -----
> primitiveSetWindowTitle
> "Set the title of the Scratch window."
>
> | titleStr src titleOop count |
> <export: true>
> <var: 'titleStr' declareC: 'char titleStr[1000]'>
> + <var: 'src' type: #'char *'>
> - <var: 'src' declareC: 'char * src'>
>
> titleOop := interpreterProxy stackValue: 0.
>
> + interpreterProxy success: (interpreterProxy isBytes: titleOop).
> - ((interpreterProxy isIntegerObject: titleOop) or:
> - [(interpreterProxy isBytes: titleOop) not]) ifTrue: [
> - interpreterProxy success: false].
>
> interpreterProxy failed ifTrue: [^ 0].
>
> + src := self cCoerce: (interpreterProxy firstIndexableField:
> titleOop) to: #'char *'.
> - src := self cCoerce: (interpreterProxy firstIndexableField:
> titleOop) to: 'char *'.
> count := interpreterProxy stSizeOf: titleOop.
> count >= 1000 ifTrue: [interpreterProxy success: false. ^ 0].
> 0 to: count - 1 do: [:i | titleStr at: i put: (src at: i)].
> titleStr at: count put: 0.
>
> + self SetScratchWindowTitle: titleStr.
> - self cCode: 'SetScratchWindowTitle(titleStr)'.
>
> interpreterProxy pop: 1. "pop arg, leave rcvr on stack"
> + ^ 0!
> - ^ 0
> -
> - !
>
> Item was changed:
> ----- Method: ScratchPlugin>>primitiveShortToLongPath (in category 'os
> functions') -----
> primitiveShortToLongPath
> "On Windows, convert a short file/path name into a long one. Fail
> on other platforms."
>
> | shortPath longPath ptr shortPathOop result count resultOop |
> <export: true>
> <var: 'shortPath' declareC: 'char shortPath[1000]'>
> <var: 'longPath' declareC: 'char longPath[1000]'>
> + <var: 'ptr' type: #'char *'>
> - <var: 'ptr' declareC: 'char * ptr'>
>
> shortPathOop := interpreterProxy stackValue: 0.
>
> + (interpreterProxy isBytes: shortPathOop) ifFalse:
> + [interpreterProxy success: false. ^ 0].
> - ((interpreterProxy isIntegerObject: shortPathOop) or:
> - [(interpreterProxy isBytes: shortPathOop) not]) ifTrue: [
> - interpreterProxy success: false. ^ 0].
>
> + ptr := self cCoerce: (interpreterProxy firstIndexableField:
> shortPathOop) to: #'char *'.
> - ptr := self cCoerce: (interpreterProxy firstIndexableField:
> shortPathOop) to: 'char *'.
> count := interpreterProxy stSizeOf: shortPathOop.
> count >= 1000 ifTrue: [interpreterProxy success: false. ^ 0].
> 0 to: count - 1 do: [:i | shortPath at: i put: (ptr at: i)].
> shortPath at: count put: 0.
>
> result := self cCode: 'WinShortToLongPath(shortPath, longPath,
> 1000)'.
> result = -1 ifTrue: [interpreterProxy success: false. ^ 0].
>
> + count := self strlen: longPath.
> - count := self cCode: 'strlen(longPath)'.
> resultOop := interpreterProxy instantiateClass: interpreterProxy
> classString indexableSize: count.
> + ptr := self cCoerce: (interpreterProxy firstIndexableField:
> resultOop) to: #'char *'.
> - ptr := self cCoerce: (interpreterProxy firstIndexableField:
> resultOop) to: 'char *'.
> 0 to: count - 1 do: [:i | ptr at: i put: (longPath at: i)].
>
> interpreterProxy pop: 2 thenPush: resultOop. "pop arg and rcvr,
> push result"
> + ^ 0!
> - ^ 0
> - !
>
> Item was changed:
> ----- Method: SoundCodecPlugin>>primitiveGSMDecode (in category 'gsm
> 6.10 codec') -----
> primitiveGSMDecode
>
> | dstIndex dst srcIndex src frameCount state srcSize dstSize
> result srcDelta dstDelta |
> <export: true>
> dstIndex := interpreterProxy stackIntegerValue: 0.
> + dst := interpreterProxy stackValue: 1.
> - dst := interpreterProxy stackObjectValue: 1.
> srcIndex := interpreterProxy stackIntegerValue: 2.
> + src := interpreterProxy stackValue: 3.
> - src := interpreterProxy stackObjectValue: 3.
> frameCount := interpreterProxy stackIntegerValue: 4.
> + state := interpreterProxy stackValue: 5.
> - state := interpreterProxy stackObjectValue: 5.
> interpreterProxy success: (interpreterProxy isWords: dst).
> interpreterProxy success: (interpreterProxy isBytes: src).
> interpreterProxy success: (interpreterProxy isBytes: state).
> interpreterProxy failed ifTrue:[^ nil].
> srcSize := interpreterProxy slotSizeOf: src.
> dstSize := (interpreterProxy slotSizeOf: dst) * 2.
> + self cCode: 'gsmDecode(state + BaseHeaderSize, frameCount, src,
> srcIndex, srcSize, dst, dstIndex, dstSize, &srcDelta, &dstDelta)'.
> - self cCode: 'gsmDecode(state + 4, frameCount, src, srcIndex,
> srcSize, dst, dstIndex, dstSize, &srcDelta, &dstDelta)'.
> interpreterProxy failed ifTrue:[^ nil].
> result := interpreterProxy makePointwithxValue: srcDelta yValue:
> dstDelta.
> interpreterProxy failed ifTrue:[^ nil].
> + interpreterProxy pop: 6 thenPush: result!
> - interpreterProxy pop: 6.
> - interpreterProxy push: result.
> - !
>
> Item was changed:
> ----- Method: SoundCodecPlugin>>primitiveGSMEncode (in category 'gsm
> 6.10 codec') -----
> primitiveGSMEncode
>
> | dstIndex dst srcIndex src frameCount state srcSize dstSize
> result srcDelta dstDelta |
> <export: true>
> dstIndex := interpreterProxy stackIntegerValue: 0.
> + dst := interpreterProxy stackValue: 1.
> - dst := interpreterProxy stackObjectValue: 1.
> srcIndex := interpreterProxy stackIntegerValue: 2.
> + src := interpreterProxy stackValue: 3.
> - src := interpreterProxy stackObjectValue: 3.
> frameCount := interpreterProxy stackIntegerValue: 4.
> + state := interpreterProxy stackValue: 5.
> - state := interpreterProxy stackObjectValue: 5.
> interpreterProxy success: (interpreterProxy isBytes: dst).
> interpreterProxy success: (interpreterProxy isWords: src).
> interpreterProxy success: (interpreterProxy isBytes: state).
> interpreterProxy failed ifTrue:[^ nil].
> srcSize := (interpreterProxy slotSizeOf: src) * 2.
> dstSize := interpreterProxy slotSizeOf: dst.
> + self cCode: 'gsmEncode(state + BaseHeaderSize, frameCount, src,
> srcIndex, srcSize, dst, dstIndex, dstSize, &srcDelta, &dstDelta)'.
> - self cCode: 'gsmEncode(state + 4, frameCount, src, srcIndex,
> srcSize, dst, dstIndex, dstSize, &srcDelta, &dstDelta)'.
> interpreterProxy failed ifTrue:[^ nil].
> result := interpreterProxy makePointwithxValue: srcDelta yValue:
> dstDelta.
> interpreterProxy failed ifTrue:[^ nil].
> + interpreterProxy pop: 6 thenPush: result!
> - interpreterProxy pop: 6.
> - interpreterProxy push: result.
> - !
>
> Item was changed:
> ----- Method: SoundCodecPlugin>>primitiveGSMNewState (in category 'gsm
> 6.10 codec') -----
> primitiveGSMNewState
>
> + | state |
> - | stateBytes state |
> <export: true>
> - stateBytes := self cCode: 'gsmStateBytes()'.
> state := interpreterProxy
> + instantiateClass: interpreterProxy
> classByteArray
> + indexableSize: self gsmStateBytes.
> + self gsmInitState: state + BaseHeaderSize.
> + interpreterProxy pop: 1 thenPush: state!
> - instantiateClass: interpreterProxy classByteArray
> - indexableSize: stateBytes.
> - self cCode: 'gsmInitState(state + 4)'.
> - interpreterProxy pop: 1.
> - interpreterProxy push: state.
> - !
>
> Item was changed:
> ----- Method: SpurMemoryManager>>become:with:twoWay:copyHash: (in
> category 'become api') -----
> become: array1 with: array2 twoWay: twoWayFlag copyHash: copyHashFlag
> "All references to each object in array1 are swapped with all
> references to the
> corresponding object in array2. That is, all pointers to one
> object are replaced
> with with pointers to the other. The arguments must be arrays of
> the same length.
> Answers PrimNoErr if the primitive succeeds, otherwise a relevant
> error code."
> "Implementation: Uses lazy forwarding to defer updating references
> until message send."
> | ec |
> self assert: becomeEffectsFlags = 0.
> self leakCheckBecome ifTrue:
> [self runLeakCheckerForFullGC: true].
> (self isArray: array1) ifFalse:
> [^PrimErrBadReceiver].
> ((self isArray: array2)
> and: [(self numSlotsOf: array1) = (self numSlotsOf: array2)])
> ifFalse:
> [^PrimErrBadArgument].
> (twoWayFlag or: [copyHashFlag])
> ifTrue:
> [ec := self containsOnlyValidBecomeObjects: array1
> and: array2]
> ifFalse:
> [self followForwardedObjectFields: array2 toDepth:
> 0.
> ec := self containsOnlyValidBecomeObjects: array1].
> ec ~= 0 ifTrue: [^ec].
>
> coInterpreter preBecomeAction.
> twoWayFlag
> ifTrue:
> [self innerBecomeObjectsIn: array1 and: array2
> copyHash: copyHashFlag]
> ifFalse:
> [self innerBecomeObjectsIn: array1 to: array2
> copyHash: copyHashFlag].
> self postBecomeScanClassTable.
> + self followSpecialObjectsOop.
> coInterpreter postBecomeAction: becomeEffectsFlags.
> becomeEffectsFlags := 0.
>
> self leakCheckBecome ifTrue:
> [self runLeakCheckerForFullGC: true].
>
> ^PrimNoErr "success"!
>
> Item was changed:
> ----- Method: SpurMemoryManager>>eliminateAndFreeForwarders (in category
> 'gc - global') -----
> eliminateAndFreeForwarders
> "As the final phase of global garbage collect, sweep the heap to
> follow
> forwarders, then free forwarders, coalescing with free space as
> we go."
> | lowestFree firstFree lastFree |
> <inline: false>
> self flag: 'this might be unnecessary. if we were to track
> firstFreeChunk we might be able to repeat the
> freeUnmarkedObjectsAndSortAndCoalesceFreeSpace; compact cycle until
> firstFreeChunk reaches a fixed point'.
> self assert: (self isForwarded: nilObj) not.
> self assert: (self isForwarded: falseObj) not.
> self assert: (self isForwarded: trueObj) not.
> self assert: (self isForwarded: self freeListsObj) not.
> self assert: (self isForwarded: hiddenRootsObj) not.
> self assert: (self isForwarded: classTableFirstPage) not.
> + self followSpecialObjectsOop.
> - (self isForwarded: specialObjectsOop) ifTrue:
> - [specialObjectsOop := self followForwarded:
> specialObjectsOop].
> "N.B. we don't have to explicitly do mapInterpreterOops
> since the scavenge below will do it."
> self followForwardedObjStacks.
> scavenger followRememberedForwardersAndForgetFreeObjects.
> self doScavenge: DontTenureButDoUnmark.
> self checkFreeSpace.
> lowestFree := 0.
> "sweep, following forwarders in all live objects, and finding the
> first forwarder."
> self allOldSpaceEntitiesDo:
> [:o|
> ((self isFreeObject: o) or: [self isForwarded: o])
> ifTrue:
> [lowestFree = 0 ifTrue:
> [lowestFree := o]]
> ifFalse:
> [0 to: (self numPointerSlotsOf: o) - 1 do:
> [:i| | f |
> f := self fetchPointer: i
> ofObject: o.
> (self isOopForwarded: f) ifTrue:
> [f := self
> followForwarded: f.
> + self storePointer: i
> ofObject: o withValue: f]]]].
> - self assert: (self
> isYoung: f) not.
> - self
> storePointerUnchecked: i ofObject: o withValue: f]]]].
> self checkFreeSpace.
> lowestFree = 0 ifTrue: "yeah, right..."
> [^self].
> firstFree := lastFree := 0.
> "Sweep from lowest forwarder, coalescing runs of forwarders and
> free objects."
> self allOldSpaceEntitiesFrom: lowestFree do:
> [:o|
> (self isFreeObject: o)
> ifTrue: "two cases, isolated, in which case leave
> alone, or adjacent,
> in which case, remove from free
> set prior to coalesce."
> [| next |
> next := self objectAfter: o limit:
> endOfMemory.
> self assert: (next = endOfMemory or:
> [(self isFreeObject: next) not]). "free chunks have already been coalesced"
> (firstFree ~= 0
> or: [next ~= endOfMemory and: [self
> isForwarded: next]]) ifTrue:
> [firstFree = 0 ifTrue:
> [firstFree := o].
> lastFree := o.
> self detachFreeObject: o.
> self checkFreeSpace]]
> ifFalse:
> [(self isForwarded: o)
> ifTrue:
> [firstFree = 0 ifTrue:
> [firstFree := o].
> lastFree := o]
> ifFalse:
> [firstFree ~= 0 ifTrue:
> [| start bytes |
> start := self
> startOfObject: firstFree.
> bytes := (self
> addressAfter: lastFree) - start.
> self
> addFreeChunkWithBytes: bytes at: start.
> self
> checkFreeSpace].
> firstFree := 0]]].
> firstFree ~= 0 ifTrue:
> [| start bytes |
> start := self startOfObject: firstFree.
> bytes := (self addressAfter: lastFree) - start.
> self addFreeChunkWithBytes: bytes at: start].
> self checkFreeSpace!
>
> Item was added:
> + ----- Method: SpurMemoryManager>>followSpecialObjectsOop (in category
> 'become implementation') -----
> + followSpecialObjectsOop
> + (self isForwarded: specialObjectsOop) ifTrue:
> + [specialObjectsOop := self followForwarded:
> specialObjectsOop]!
>
> Item was changed:
> ----- Method: StackInterpreter>>markAndTraceStackPage: (in category
> 'object memory support') -----
> markAndTraceStackPage: thePage
> | theSP theFP frameRcvrOffset callerFP oop |
> <var: #thePage type: #'StackPage *'>
> <var: #theSP type: #'char *'>
> <var: #theFP type: #'char *'>
> <var: #frameRcvrOffset type: #'char *'>
> <var: #callerFP type: #'char *'>
> <inline: false>
>
> self assert: (stackPages isFree: thePage) not.
> self assert: thePage trace ~= StackPageTraced.
> thePage trace: StackPageTraced.
>
> theSP := thePage headSP.
> theFP := thePage headFP.
> "Skip the instruction pointer on top of stack of inactive pages."
> thePage = stackPage ifFalse:
> [theSP := theSP + BytesPerWord].
> [frameRcvrOffset := self frameReceiverOffset: theFP.
> [theSP <= frameRcvrOffset] whileTrue:
> [oop := stackPages longAt: theSP.
> + (objectMemory isOopForwarded: oop) ifTrue:
> + [oop := objectMemory followForwarded: oop.
> + stackPages longAt: theSP put: oop].
> (objectMemory isImmediate: oop) ifFalse:
> [objectMemory markAndTrace: oop].
> theSP := theSP + BytesPerWord].
> (self frameHasContext: theFP) ifTrue:
> [self assert: (objectMemory isContext: (self frameContext:
> theFP)).
> objectMemory markAndTrace: (self frameContext: theFP)].
> objectMemory markAndTrace: (self iframeMethod: theFP).
> (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
> [theSP := theFP + FoxCallerSavedIP + BytesPerWord.
> theFP := callerFP].
> theSP := theFP + FoxCallerSavedIP. "caller ip is
> frameCallerContext in a base frame"
> [theSP <= thePage baseAddress] whileTrue:
> [oop := stackPages longAt: theSP.
> + (objectMemory isOopForwarded: oop) ifTrue:
> + [oop := objectMemory followForwarded: oop.
> + stackPages longAt: theSP put: oop].
> (objectMemory isImmediate: oop) ifFalse:
> [objectMemory markAndTrace: oop].
> theSP := theSP + BytesPerWord]!
>
> Item was changed:
> ----- Method: ThreadedFFIPlugin>>ffiArgument:Spec:Class:in: (in category
> 'callout support') -----
> ffiArgument: oop Spec: argSpec Class: argClass in: calloutState
> "Callout support. Prepare the given oop as argument.
> argSpec defines the compiled spec for the argument.
> argClass (if non-nil) defines the required (super)class for the
> argument."
> <var: #calloutState type: #'CalloutState *'>
> | valueOop oopClass isStruct nilOop |
> <inline: false>
> oopClass := interpreterProxy fetchClassOf: oop. "Prefetch class
> (we'll need it)"
> nilOop := interpreterProxy nilObject.
> "Do the necessary type checks"
> argClass = nilOop ifFalse:[
> "Type check 1:
> Is the required class of the argument a subclass of
> ExternalStructure?"
> (interpreterProxy includesBehavior: argClass
> ThatOf: interpreterProxy
> classExternalStructure)
> ifFalse:[^FFIErrorWrongType]. "Nope. Fail."
> "Type check 2:
> Is the class of the argument a subclass of required class?"
> ((nilOop = oop) or:[interpreterProxy includesBehavior:
> oopClass ThatOf: argClass])
> ifFalse:[^FFIErrorCoercionFailed]. "Nope.
> Fail."
> "Okay, we've passed the type check (so far)"
> ].
>
> "Check if oopClass is a subclass of ExternalStructure.
> If this is the case we'll work on it's handle and not the actual
> oop."
> isStruct := false.
> + ((interpreterProxy isImmediate: oop) or:[oop = nilOop]) ifFalse:[
> + "#isPointers: will fail if oop is immediate so don't even
> attempt to use it"
> - ((interpreterProxy isIntegerObject: oop) or:[oop = nilOop])
> ifFalse:[
> - "#isPointers: will fail if oop is SmallInteger so don't
> even attempt to use it"
> (interpreterProxy isPointers: oop)
> ifTrue:[isStruct := interpreterProxy
> includesBehavior: oopClass
> ThatOf:
> interpreterProxy classExternalStructure.
> (argClass = nilOop or:[isStruct])
>
> ifFalse:[^FFIErrorCoercionFailed]].
> "note: the test for #isPointers: above should speed up
> execution since no pointer type ST objects are allowed in external calls
> and thus if #isPointers: is true then the arg must be ExternalStructure to
> work. If it isn't then the code fails anyways so speed isn't an issue"
> ].
>
> "Determine valueOop (e.g., the actual oop to pass as argument)"
> isStruct
> ifTrue:[valueOop := interpreterProxy fetchPointer: 0
> ofObject: oop]
> ifFalse:[valueOop := oop].
>
> "Fetch and check the contents of the compiled spec"
> - (interpreterProxy isIntegerObject: argSpec)
> - ifTrue:[^FFIErrorWrongType].
> (interpreterProxy isWords: argSpec)
> ifFalse:[^FFIErrorWrongType].
> calloutState ffiArgSpecSize: (interpreterProxy slotSizeOf:
> argSpec).
> calloutState ffiArgSpecSize = 0 ifTrue:[^FFIErrorWrongType].
> calloutState ffiArgSpec: (interpreterProxy firstIndexableField:
> argSpec).
> calloutState ffiArgHeader: (interpreterProxy longAt: calloutState
> ffiArgSpec).
>
> "Do the actual preparation of the argument"
> "Note: Order is important since FFIFlagStructure + FFIFlagPointer
> is used to represent 'typedef void* VoidPointer' and VoidPointer really is
> *struct* not pointer."
>
> (calloutState ffiArgHeader anyMask: FFIFlagStructure) ifTrue:[
> "argument must be ExternalStructure"
> isStruct ifFalse:[^FFIErrorCoercionFailed].
> (calloutState ffiArgHeader anyMask: FFIFlagAtomic)
> ifTrue:[^FFIErrorWrongType]. "bad combination"
> ^self ffiPushStructureContentsOf: valueOop in:
> calloutState].
>
> (calloutState ffiArgHeader anyMask: FFIFlagPointer) ifTrue:[
> + "no integers (or characters) for pointers please"
> + (interpreterProxy isImmediate: oop)
> - "no integers for pointers please"
> - (interpreterProxy isIntegerObject: oop)
> ifTrue:[^FFIErrorIntAsPointer].
>
> "but allow passing nil pointer for any pointer type"
> oop = nilOop ifTrue:[^self ffiPushPointer: nil in:
> calloutState].
>
> "argument is reference to either atomic or structure type"
> (calloutState ffiArgHeader anyMask: FFIFlagAtomic) ifTrue:[
> isStruct "e.g., ExternalData"
> ifTrue:[^self ffiAtomicStructByReference:
> oop Class: oopClass in: calloutState]
> ifFalse:[^self ffiAtomicArgByReference:
> oop Class: oopClass in: calloutState].
> "********* NOTE: The above uses 'oop' not
> 'valueOop' (for ExternalData) ******"
> ].
>
> "Needs to be external structure here"
> isStruct ifFalse:[^FFIErrorCoercionFailed].
> ^self ffiPushPointerContentsOf: valueOop in: calloutState].
>
> (calloutState ffiArgHeader anyMask: FFIFlagAtomic) ifTrue:[
> "argument is atomic value"
> ^self ffiArgByValue: valueOop in: calloutState].
> "None of the above - bad spec"
> ^FFIErrorWrongType!
>
> Item was changed:
> ----- Method: ThreadedFFIPlugin>>ffiContentsOfHandle:errCode: (in
> category 'callout support') -----
> ffiContentsOfHandle: oop errCode: errCode
> "Make sure that the given oop is a valid external handle"
> <inline: true>
> + ((interpreterProxy isBytes: oop)
> + and: [(interpreterProxy byteSizeOf: oop) = 4]) ifFalse:
> + [^self ffiFail: errCode].
> - (interpreterProxy isIntegerObject: oop)
> - ifTrue:[^self ffiFail: errCode].
> - (interpreterProxy isBytes: oop)
> - ifFalse:[^self ffiFail: errCode].
> - ((interpreterProxy byteSizeOf: oop) == 4)
> - ifFalse:[^self ffiFail: errCode].
> ^interpreterProxy fetchPointer: 0 ofObject: oop!
>
> Item was changed:
> ----- Method: ThreadedFFIPlugin>>ffiIntegerValueOf: (in category
> 'callout support') -----
> ffiIntegerValueOf: oop
> "Support for generic callout. Return an integer value that is
> coerced as C would do."
> | oopClass |
> <inline: true>
> + (interpreterProxy isIntegerObject: oop) ifTrue:
> + [^interpreterProxy integerValueOf: oop].
> + oop = interpreterProxy nilObject ifTrue: [^0]. "@@: should we
> really allow this????"
> + oop = interpreterProxy falseObject ifTrue: [^0].
> + oop = interpreterProxy trueObject ifTrue: [^1].
> - (interpreterProxy isIntegerObject: oop) ifTrue:[^interpreterProxy
> integerValueOf: oop].
> - oop = interpreterProxy nilObject ifTrue:[^0]. "@@: should we
> really allow this????"
> - oop = interpreterProxy falseObject ifTrue:[^0].
> - oop = interpreterProxy trueObject ifTrue:[^1].
> oopClass := interpreterProxy fetchClassOf: oop.
> + oopClass = interpreterProxy classFloat ifTrue:
> + [^(interpreterProxy floatValueOf: oop) asInteger].
> + oopClass = interpreterProxy classCharacter ifTrue:
> + [^interpreterProxy characterValueOf: oop].
> + oopClass = interpreterProxy classLargePositiveInteger ifTrue:
> + [^interpreterProxy positive32BitValueOf: oop].
> + ^interpreterProxy signedMachineIntegerValueOf: oop "<- will fail
> if not integer"!
> - oopClass = interpreterProxy classFloat
> - ifTrue:[^(interpreterProxy floatValueOf: oop) asInteger].
> - oopClass = interpreterProxy classCharacter
> - ifTrue:[^interpreterProxy fetchInteger: 0 ofObject: oop].
> - oopClass = interpreterProxy classLargePositiveInteger
> - ifTrue:[^interpreterProxy positive32BitValueOf: oop].
> - ^interpreterProxy signed32BitValueOf: oop "<- will fail if not
> integer"!
>
> Item was changed:
> ----- Method: ThreadedFFIPlugin>>ffiValidateExternalData:AtomicType: (in
> category 'callout support') -----
> ffiValidateExternalData: oop AtomicType: atomicType
> "Validate if the given oop (an instance of ExternalData) can be
> passed as a pointer to the given atomic type."
> | ptrType specOop spec specType |
> <inline: true>
> ptrType := interpreterProxy fetchPointer: 1 ofObject: oop.
> + ((interpreterProxy isPointers: ptrType)
> + and: [(interpreterProxy slotSizeOf: ptrType) >= 2]) ifFalse:
> + [^FFIErrorWrongType].
> - (interpreterProxy isIntegerObject: ptrType)
> - ifTrue:[^FFIErrorWrongType].
> - (interpreterProxy isPointers: ptrType)
> - ifFalse:[^FFIErrorWrongType].
> - (interpreterProxy slotSizeOf: ptrType) < 2
> - ifTrue:[^FFIErrorWrongType].
> specOop := interpreterProxy fetchPointer: 0 ofObject: ptrType.
> + ((interpreterProxy isWords: specOop)
> + and: [(interpreterProxy slotSizeOf: specOop) > 0]) ifFalse:
> + [^FFIErrorWrongType].
> - (interpreterProxy isIntegerObject: specOop)
> - ifTrue:[^FFIErrorWrongType].
> - (interpreterProxy isWords: specOop)
> - ifFalse:[^FFIErrorWrongType].
> - (interpreterProxy slotSizeOf: specOop) = 0
> - ifTrue:[^FFIErrorWrongType].
> spec := interpreterProxy fetchPointer: 0 ofObject: specOop.
> + (self isAtomicType: spec) ifFalse:
> + [^FFIErrorWrongType].
> - (self isAtomicType: spec)
> - ifFalse:[^FFIErrorWrongType].
> specType := self atomicTypeOf: spec.
> + specType ~= atomicType ifTrue:
> + "Allow for signed/unsigned conversion but nothing else.
> + See FFIConstants class>>#initializeTypeConstants"
> + [(atomicType >= FFITypeUnsignedByte
> + and: [atomicType <= FFITypeSignedChar
> + and: [(atomicType >> 1) = (specType >> 1)]]) ifFalse:
> + [^FFIErrorCoercionFailed]].
> - specType ~= atomicType ifTrue:[
> - "allow for signed/unsigned conversion but nothing else"
> - (atomicType > FFITypeBool and:[atomicType <
> FFITypeSingleFloat])
> - ifFalse:[^FFIErrorCoercionFailed].
> - ((atomicType >> 1) = (specType >> 1))
> - ifFalse:[^FFIErrorCoercionFailed]].
> ^0!
>
> Item was changed:
> ----- Method: UnicodePlugin>>asCString: (in category 'utility') -----
> asCString: stringOop
> "Return a C char * pointer into the given Squeak string object."
> "Warning: A Squeak string is not necessarily null-terminated."
> "Warning: the resulting pointer may become invalid after the next
> garbage collection and should only be using during the current primitive
> call."
>
> + <returnTypeC: #'char *'>
> - <inline: false>
> - <returnTypeC: 'char *'>
>
> + interpreterProxy success: (interpreterProxy isBytes: stringOop).
> - ((interpreterProxy isIntegerObject: stringOop) or:
> - [(interpreterProxy isBytes: stringOop) not]) ifTrue: [
> - interpreterProxy success: false.
> - ^ 0].
>
> + ^interpreterProxy failed
> + ifTrue: [0]
> + ifFalse: [self cCoerce: (interpreterProxy
> firstIndexableField: stringOop) to: #'char *']!
> - ^ self cCoerce: (interpreterProxy firstIndexableField: stringOop)
> to: 'char *'
> - !
>
> Item was changed:
> ----- Method: UnicodePlugin>>cWordsPtr:minSize: (in category 'utility')
> -----
> cWordsPtr: oop minSize: minSize
> "Return a C pointer to the first indexable field of oop, which
> must be a words object of at least the given size."
> "Warning: the resulting pointer may become invalid after the next
> garbage collection and should only be using during the current primitive
> call."
>
> + <returnTypeC: #'void *'>
> - <inline: false>
> - <returnTypeC: 'void *'>
>
> interpreterProxy success:
> + ((interpreterProxy isWords: oop)
> + and: [(interpreterProxy stSizeOf: oop) >= minSize]).
> + ^interpreterProxy failed
> + ifTrue: [0]
> + ifFalse: [self cCoerce: (interpreterProxy
> firstIndexableField: oop) to: #'void *']!
> - ((interpreterProxy isIntegerObject: oop) not and:
> - [(interpreterProxy isWords: oop) and:
> - [(interpreterProxy stSizeOf: oop) >= minSize]]).
> - interpreterProxy failed ifTrue: [^ 0].
> - ^ self cCoerce: (interpreterProxy firstIndexableField: oop) to:
> 'void *'
> - !
>
> Item was changed:
> ----- Method: UnicodePlugin>>copyString:into:max: (in category
> 'utility') -----
> copyString: stringOop into: stringPtr max: maxChars
> "Copy the Squeak string into a temporary buffer and add a
> terminating null byte. Fail if there is not sufficent space in the buffer."
>
> | srcPtr count |
> <inline: false>
> + <var: 'stringPtr' type: #'char *'>
> + <var: 'srcPtr' type: #'char *'>
> - <var: 'stringPtr' declareC: 'char *stringPtr'>
> - <var: 'srcPtr' declareC: 'char *srcPtr'>
>
> + ((interpreterProxy isBytes: stringOop)
> + and: [(count := interpreterProxy stSizeOf: stringOop) < maxChars])
> ifFalse:
> + [interpreterProxy success: false.
> - ((interpreterProxy isIntegerObject: stringOop) or:
> - [(interpreterProxy isBytes: stringOop) not]) ifTrue: [
> - interpreterProxy success: false.
> ^ 0].
>
> + srcPtr := self cCoerce: (interpreterProxy firstIndexableField:
> stringOop) to: #'char *'.
> - count := interpreterProxy stSizeOf: stringOop.
> - count < maxChars ifFalse: [
> - interpreterProxy success: false.
> - ^ 0].
> -
> - srcPtr := self cCoerce: (interpreterProxy firstIndexableField:
> stringOop) to: 'char *'.
> 1 to: count do: [:i | self cCode: '*stringPtr++ = *srcPtr++'].
> self cCode: '*stringPtr = 0'.
> + ^ 0!
> - ^ 0
> - !
>
> Item was changed:
> ----- Method: UnicodePlugin>>primitiveClipboardGet (in category
> 'primitives') -----
> primitiveClipboardGet
> "Read the clipboard into the given UTF16 string.."
>
> | utf16Oop utf16 utf16Length count |
> <export: true>
> + <var: 'utf16' type: #'unsigned short *'>
> - <var: 'utf16' declareC: 'unsigned short *utf16'>
>
> utf16Oop := interpreterProxy stackValue: 0.
>
> + interpreterProxy success: (interpreterProxy isWords: utf16Oop).
> - ((interpreterProxy isIntegerObject: utf16Oop) or:
> - [(interpreterProxy isWords: utf16Oop) not]) ifTrue: [
> - interpreterProxy success: false].
>
> interpreterProxy failed ifTrue: [^ 0].
>
> + utf16 := self cCoerce: (interpreterProxy firstIndexableField:
> utf16Oop) to: #'unsigned short *'.
> - utf16 := self cCoerce: (interpreterProxy firstIndexableField:
> utf16Oop) to: 'unsigned short *'.
> utf16Length := 2 * (interpreterProxy stSizeOf: utf16Oop).
>
> + count := self unicodeClipboard: utf16 Get: utf16Length.
> - count := self cCode: 'unicodeClipboardGet(utf16, utf16Length)'.
>
> interpreterProxy pop: 2
> thenPush: (interpreterProxy integerObjectOf: count).
>
> + ^ 0!
> - ^ 0
> - !
>
> Item was changed:
> ----- Method: UnicodePlugin>>primitiveClipboardPut (in category
> 'primitives') -----
> primitiveClipboardPut
> "Set the clipboard to a UTF16 string.."
>
> | strOop count utf16 utf16Length |
> <export: true>
> + <var: 'utf16' type: #'unsigned short *'>
> - <var: 'utf16' declareC: 'unsigned short *utf16'>
>
> strOop := interpreterProxy stackValue: 1.
> count := interpreterProxy stackIntegerValue: 0.
>
> + interpreterProxy success: (interpreterProxy isWords: strOop).
> - ((interpreterProxy isIntegerObject: strOop) or:
> - [(interpreterProxy isWords: strOop) not]) ifTrue: [
> - interpreterProxy success: false].
>
> interpreterProxy failed ifTrue: [^ 0].
>
> + utf16 := self cCoerce: (interpreterProxy firstIndexableField:
> strOop) to: #'unsigned short *'.
> - utf16 := self cCoerce: (interpreterProxy firstIndexableField:
> strOop) to: 'unsigned short *'.
> utf16Length := 2 * (interpreterProxy stSizeOf: strOop).
> ((count >= 0) & (count < utf16Length)) ifTrue: [utf16Length :=
> count].
>
> + self unicodeClipboard: utf16 Put: utf16Length.
> - self cCode: 'unicodeClipboardPut(utf16, utf16Length)'.
>
> interpreterProxy pop: 2. "pop args, leave rcvr on stack"
> + ^ 0!
> - ^ 0
> - !
>
> Item was changed:
> ----- Method: WeDoPlugin>>primRead (in category 'translated prims') -----
> primRead
> "Read data from the WeDo port into the given buffer (a ByteArray
> or String). Answer the number of bytes read."
>
> | bufOop bufPtr bufSize byteCount |
> <export: true>
> <var: 'bufPtr' declareC: 'char *bufPtr'>
>
> bufOop := interpreterProxy stackValue: 0.
> + (interpreterProxy isBytes: bufOop) ifFalse: [
> - ((interpreterProxy isIntegerObject: bufOop) or:
> - [(interpreterProxy isBytes: bufOop) not]) ifTrue: [
> interpreterProxy success: false.
> ^ 0].
> bufPtr := self cCoerce: (interpreterProxy firstIndexableField:
> bufOop) to: 'char *'.
> bufSize := interpreterProxy stSizeOf: bufOop.
> interpreterProxy failed ifTrue: [^ 0].
>
> byteCount := self cCode: 'WeDoRead(bufPtr, bufSize)'.
> byteCount < 0 ifTrue: [
> interpreterProxy success: false.
> ^ 0].
>
> interpreterProxy pop: 2.
> "pop args and rcvr"
> interpreterProxy pushInteger: byteCount. "push result"
> ^ 0
> !
>
> Item was changed:
> ----- Method: WeDoPlugin>>primWrite (in category 'translated prims')
> -----
> primWrite
> "Write data to the WeDo port from the given buffer (a ByteArray or
> String). Answer the number of bytes written."
>
> | bufOop bufPtr bufSize byteCount |
> <export: true>
> <var: 'bufPtr' declareC: 'char *bufPtr'>
>
> bufOop := interpreterProxy stackValue: 0.
> + (interpreterProxy isBytes: bufOop) ifFalse: [
> - ((interpreterProxy isIntegerObject: bufOop) or:
> - [(interpreterProxy isBytes: bufOop) not]) ifTrue: [
> interpreterProxy success: false.
> ^ 0].
> bufPtr := self cCoerce: (interpreterProxy firstIndexableField:
> bufOop) to: 'char *'.
> bufSize := interpreterProxy stSizeOf: bufOop.
> interpreterProxy failed ifTrue: [^ 0].
>
> byteCount := self cCode: 'WeDoWrite(bufPtr, bufSize)'.
> byteCount < 0 ifTrue: [
> interpreterProxy success: false.
> ^ 0].
>
> interpreterProxy pop: 2.
> "pop args and rcvr"
> interpreterProxy pushInteger: byteCount. "push result"
> ^ 0
> !
>
>
--
best,
Eliot
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://lists.squeakfoundation.org/pipermail/vm-dev/attachments/20140130/2522777d/attachment-0001.htm
More information about the Vm-dev
mailing list