[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