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@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 !