Vm-dev December 2012

vm-dev@lists.squeakfoundation.org

22 participants
93 discussions

[Vm-dev] OSProcessPlugin: VMConstruction-Plugins-OSProcessPlugin.oscog-eem.37.mcz
by squeak-dev-noreply＠lists.squeakfoundation.org 12 Dec '12

12 Dec '12

Eliot Miranda uploaded a new version of VMConstruction-Plugins-OSProcessPlugin to project OSProcessPlugin: http://www.squeaksource.com/OSProcessPlugin/VMConstruction-Plugins-OSProces… ==================== Summary ==================== Name: VMConstruction-Plugins-OSProcessPlugin.oscog-eem.37 Author: eem Time: 11 December 2012, 4:39:34 am UUID: 66e9d886-c656-4392-be32-84729d92e8b8 Ancestors: VMConstruction-Plugins-OSProcessPlugin.oscog-eem.36 Merge with MConstruction-Plugins-OSProcessPlugin-dtl.35. In particular restore missing code to forwardSignal:toSemaphoreAt:

1 0

VM Maker: VMMaker.oscog-eem.231.mcz
by commits＠source.squeak.org 12 Dec '12

12 Dec '12

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.231.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.231 Author: eem Time: 11 December 2012, 4:41:13.926 pm UUID: 3222a519-8cd5-4e1a-9689-6534df290217 Ancestors: VMMaker.oscog-eem.230 Rename misnamed internameIsMutable: and internalIsImmutable: to isOopMutable: and isOopImmutable:. Affects sqVirtualMachine.c, but only part of api used in Newspeak VMs. =============== Diff against VMMaker.oscog-eem.230 =============== Item was added: + ----- Method: InterpreterProxy>>isOopImmutable: (in category 'testing') ----- + isOopImmutable: anOop + <api> + ^self error: 'not yet implemented in Smalltalk'! Item was added: + ----- Method: InterpreterProxy>>isOopMutable: (in category 'testing') ----- + isOopMutable: anOop + <api> + ^self error: 'not yet implemented in Smalltalk'! Item was removed: - ----- Method: NewCoObjectMemorySimulator>>internalIsImmutable: (in category 'simulation only') ----- - internalIsImmutable: oop - "hack around the CoInterpreter/ObjectMemory split refactoring" - ^coInterpreter internalIsImmutable: oop! Item was changed: ----- Method: NewspeakInterpreter>>bytecodePrimAtPut (in category 'common selector sends') ----- bytecodePrimAtPut "BytecodePrimAtPut will only succeed if the receiver is in the atCache. Otherwise it will fail so that the more general primitiveAtPut will put it in the cache after validating that message lookup results in a primitive response." | index rcvr atIx value | value := self internalStackTop. index := self internalStackValue: 1. rcvr := self internalStackValue: 2. self success: ((self isIntegerObject: rcvr) not and: [(self isIntegerObject: index) + and: [self isObjMutable: rcvr]]). - and: [self internalIsMutable: rcvr]]). self successful ifTrue: [atIx := (rcvr bitAnd: AtCacheMask) + AtPutBase. "Index into atPutCache" (atCache at: atIx+AtCacheOop) = rcvr ifTrue: [self commonVariable: rcvr at: (self integerValueOf: index) put: value cacheIndex: atIx. self successful ifTrue: [self fetchNextBytecode. ^self internalPop: 3 thenPush: value]]]. messageSelector := self specialSelector: 17. argumentCount := 2. self normalSend! Item was changed: ----- Method: NewspeakInterpreter>>commonAtPut: (in category 'indexing primitive support') ----- commonAtPut: stringy "This code is called if the receiver responds primitively to at:Put:. If this is so, it will be installed in the atPutCache so that subsequent calls of at: or next may be handled immediately in bytecode primitive routines." | value index rcvr atIx | self initPrimCall. rcvr := self stackObjectValue: 2. self successful ifFalse: [^self primitiveFailFor: PrimErrInappropriate]. index := self positive32BitValueOf: (self stackValue: 1). self successful ifFalse: [^self primitiveFailFor: PrimErrBadArgument]. + (self isOopImmutable: rcvr) ifTrue: - (self internalIsMutable: rcvr) ifFalse: [^self primitiveFailFor: PrimErrNoModification]. value := self stackTop. "NOTE: The atPut-cache, since it is specific to the non-super response to #at:Put:. Therefore we must determine that the message is #at:Put: (not, eg, #basicAt:Put:), and that the send is not a super-send, before using the at-cache." (messageSelector = (self specialSelector: 17) and: [lkupClass = (self fetchClassOfNonInt: rcvr)]) ifTrue: ["OK -- look in the at-cache" atIx := (rcvr bitAnd: AtCacheMask) + AtPutBase. "Index into atPutCache" (atCache at: atIx+AtCacheOop) = rcvr ifFalse: ["Rcvr not in cache. Install it..." self install: rcvr inAtCache: atCache at: atIx string: stringy]. self successful ifTrue: [self commonVariable: rcvr at: index put: value cacheIndex: atIx]. self successful ifTrue: [^ self pop: argumentCount+1 thenPush: value]]. "The slow but sure way..." self initPrimCall. stringy ifTrue: [self stObject: rcvr at: index put: (self asciiOfCharacter: value)] ifFalse: [self stObject: rcvr at: index put: value]. self successful ifTrue: [^ self pop: argumentCount+1 thenPush: value]. ! Item was changed: ----- Method: NewspeakInterpreter>>doubleExtendedDoAnythingBytecode (in category 'send bytecodes') ----- doubleExtendedDoAnythingBytecode "Replaces the Blue Book double-extended send [132], in which the first byte was wasted on 8 bits of argument count. Here we use 3 bits for the operation sub-type (opType), and the remaining 5 bits for argument count where needed. The last byte give access to 256 instVars or literals. See also secondExtendedSendBytecode" | byte2 byte3 opType top | byte2 := self fetchByte. byte3 := self fetchByte. opType := byte2 >> 5. opType = 0 ifTrue: [messageSelector := self literal: byte3. argumentCount := byte2 bitAnd: 31. ^ self normalSend]. opType = 1 ifTrue: [messageSelector := self literal: byte3. argumentCount := byte2 bitAnd: 31. ^ self superclassSend]. self fetchNextBytecode. opType = 2 ifTrue: [^ self pushReceiverVariable: byte3]. opType = 3 ifTrue: [^ self pushLiteralConstant: byte3]. opType = 4 ifTrue: [^ self pushLiteralVariable: byte3]. opType = 5 ifTrue: [top := self internalStackTop. + (self isObjImmutable: receiver) ifTrue: - (self internalIsImmutable: receiver) ifTrue: [self undoFetchNextBytecode. ^self internalCannotAssign: top to: receiver withIndex: byte3]. ^ self storePointer: byte3 ofObject: receiver withValue: top]. opType = 6 ifTrue: [top := self internalStackTop. self internalPop: 1. + (self isObjImmutable: receiver) ifTrue: - (self internalIsImmutable: receiver) ifTrue: [self undoFetchNextBytecode. ^self internalCannotAssign: top to: receiver withIndex: byte3]. ^ self storePointer: byte3 ofObject: receiver withValue: top]. opType = 7 ifTrue: [top := self internalStackTop. ^ self storePointer: ValueIndex ofObject: (self literal: byte3) withValue: top]! Item was changed: ----- Method: NewspeakInterpreter>>extendedStoreBytecode (in category 'stack bytecodes') ----- extendedStoreBytecode | descriptor variableType value variableIndex association isPop | <inline: true> isPop := currentBytecode = 130. "extendedStoreAndPopBytecode" descriptor := self fetchByte. self fetchNextBytecode. variableType := descriptor >> 6 bitAnd: 3. variableIndex := descriptor bitAnd: 63. variableType = 2 ifTrue: [^self error: 'illegal store']. value := self internalStackTop. variableType = 0 ifTrue: + [(self isObjImmutable: receiver) ifTrue: - [(self internalIsImmutable: receiver) ifTrue: [isPop ifTrue: [self internalPop: 1]. self undoFetchNextBytecode. ^self internalCannotAssign: value to: receiver withIndex: variableIndex]. ^self storePointer: variableIndex ofObject: receiver withValue: value]. variableType = 1 ifTrue: [^self storePointerUnchecked: variableIndex + TempFrameStart ofObject: localHomeContext withValue: value]. variableType = 3 ifTrue: [association := self literal: variableIndex. + (self isObjImmutable: association) ifTrue: - (self internalIsImmutable: association) ifTrue: [isPop ifTrue: [self internalPop: 1]. self undoFetchNextBytecode. ^self internalCannotAssign: value to: association withIndex: ValueIndex]. ^self storePointer: ValueIndex ofObject: association withValue: value]! Item was removed: - ----- Method: NewspeakInterpreter>>internalIsImmutable: (in category 'object format') ----- - internalIsImmutable: oop - <inline: true> - <export: true> - ^((self baseHeader: oop) bitAnd: ImmutabilityBit) ~= 0! Item was removed: - ----- Method: NewspeakInterpreter>>internalIsMutable: (in category 'object format') ----- - internalIsMutable: oop - <inline: true> - <export: true> - ^((self baseHeader: oop) bitAnd: ImmutabilityBit) = 0! Item was changed: ----- Method: NewspeakInterpreter>>primitiveByteArrayDoubleAtPut (in category 'array and stream primitive support') ----- primitiveByteArrayDoubleAtPut "Store a Double at given byte offset in a ByteArray." | byteOffset rcvr addr floatValue floatOop | <export: true> <inline: false> <var: #floatValue type:'double '> floatOop := self stackValue: 0. (self isIntegerObject: floatOop) ifTrue:[floatValue := self cCoerce: (self integerValueOf: floatOop) to:'double'] ifFalse:[floatValue := self cCoerce: (self floatValueOf: floatOop) to:'double']. byteOffset := self stackIntegerValue: 1. self failed ifTrue: [^self primitiveFailFor: PrimErrBadArgument]. rcvr := self stackObjectValue: 2. self failed ifTrue:[^self primitiveFailFor: PrimErrInappropriate]. addr := self addressOf: rcvr startingAt: byteOffset size: 8. self failed ifTrue:[^0]. + (self isOopImmutable: rcvr) ifTrue: - (self internalIsMutable: rcvr) ifFalse: [^self primitiveFailFor: PrimErrNoModification]. self cCode:'((int*)addr)[0] = ((int*)(&floatValue))[0]'. self cCode:'((int*)addr)[1] = ((int*)(&floatValue))[1]'. self pop: 3. ^self push: floatOop! Item was changed: ----- Method: NewspeakInterpreter>>primitiveByteArrayFloatAtPut (in category 'array and stream primitive support') ----- primitiveByteArrayFloatAtPut "Store a Float at the given byteOffset in a ByteArray" | byteOffset rcvr addr floatValue floatOop | <export: true> <inline: false> <var: #floatValue type:'float '> floatOop := self stackValue: 0. (self isIntegerObject: floatOop) ifTrue:[floatValue := self cCoerce: (self integerValueOf: floatOop) to:'float'] ifFalse:[floatValue := self cCoerce: (self floatValueOf: floatOop) to:'float']. byteOffset := self stackIntegerValue: 1. self failed ifTrue: [^self primitiveFailFor: PrimErrBadArgument]. rcvr := self stackObjectValue: 2. self failed ifTrue: [^self primitiveFailFor: PrimErrInappropriate]. addr := self addressOf: rcvr startingAt: byteOffset size: 4. self failed ifTrue:[^0]. + (self isOopImmutable: rcvr) ifTrue: - (self internalIsMutable: rcvr) ifFalse: [^self primitiveFailFor: PrimErrNoModification]. self cCode:'((int*)addr)[0] = ((int*)(&floatValue))[0]'. self pop: 3. ^self push: floatOop! Item was changed: ----- Method: NewspeakInterpreter>>primitiveByteArrayNByteIIntegerAtPut (in category 'array and stream primitive support') ----- primitiveByteArrayNByteIIntegerAtPut "Store a (signed or unsigned) n byte integer at the given byte offset." | isSigned byteSize byteOffset rcvr addr value max valueOop | <export: true> <inline: false> isSigned := self booleanValueOf: (self stackValue: 0). byteSize := self stackIntegerValue: 1. valueOop := self stackValue: 2. byteOffset := self stackIntegerValue: 3. self failed ifTrue: [^self primitiveFailFor: PrimErrBadArgument]. rcvr := self stackObjectValue: 4. self failed ifTrue: [^self primitiveFailFor: PrimErrInappropriate]. (byteOffset > 0 and:[byteSize = 1 or:[byteSize = 2 or:[byteSize = 4]]]) ifFalse:[^self primitiveFailFor: PrimErrBadArgument]. addr := self addressOf: rcvr startingAt: byteOffset size: byteSize. self failed ifTrue:[^0]. isSigned ifTrue:[value := self signed32BitValueOf: valueOop] ifFalse:[value := self positive32BitValueOf: valueOop]. self failed ifTrue:[^0]. byteSize < 4 ifTrue: [isSigned ifTrue:[ max := 1 << (8 * byteSize - 1). value >= max ifTrue:[^self primitiveFail]. value < (0 - max) ifTrue:[^self primitiveFail]. ] ifFalse:[ value >= (1 << (8*byteSize)) ifTrue:[^self primitiveFail]. ]. + (self isOopImmutable: rcvr) ifTrue: - (self internalIsMutable: rcvr) ifFalse: [^self primitiveFailFor: PrimErrNoModification].. "short/byte" byteSize = 1 ifTrue:[self byteAt: addr put: value] ifFalse:[ self cCode: '*((short int *) addr) = value' inSmalltalk: [self shortAt: addr put: value]]] ifFalse: + [(self isOopImmutable: rcvr) ifTrue: - [(self internalIsMutable: rcvr) ifFalse: [^self primitiveFailFor: PrimErrNoModification]. self longAt: addr put: value]. self pop: 5. ^self push: valueOop.! Item was changed: ----- Method: NewspeakInterpreter>>primitiveIntegerAtPut (in category 'sound primitives') ----- primitiveIntegerAtPut "Return the 32bit signed integer contents of a words receiver" | index rcvr sz addr value valueOop | valueOop := self stackValue: 0. index := self stackIntegerValue: 1. (self isIntegerObject: valueOop) ifTrue:[value := self integerValueOf: valueOop] ifFalse:[value := self signed32BitValueOf: valueOop]. self successful ifFalse: [^self primitiveFailFor: PrimErrBadArgument]. rcvr := self stackValue: 2. ((self isIntegerObject: rcvr) or: [(self isWords: rcvr) not]) ifTrue: [^self primitiveFailFor: PrimErrInappropriate]. sz := self lengthOf: rcvr. "number of fields" (index >= 1 and: [index <= sz]) ifFalse: [^self primitiveFailFor: PrimErrBadIndex]. + (self isOopImmutable: rcvr) ifTrue: - (self internalIsMutable: rcvr) ifFalse: [^self primitiveFailFor: PrimErrNoModification]. addr := rcvr + BaseHeaderSize - 4 "for zero indexing" + (index * 4). value := self intAt: addr put: value. self pop: 3 thenPush: valueOop "pop all; return value" ! Item was changed: ----- Method: NewspeakInterpreter>>primitiveNextPut (in category 'array and stream primitives') ----- primitiveNextPut "PrimitiveNextPut will succeed only if the stream's array is in the atPutCache. Otherwise failure will lead to proper message lookup of at:put: and subsequent installation in the cache if appropriate." | value stream index limit array atIx | value := self stackTop. stream := self stackValue: 1. ((self isPointers: stream) and: [(self lengthOf: stream) >= (StreamReadLimitIndex + 1)]) ifFalse: [^ self primitiveFail]. array := self fetchPointer: StreamArrayIndex ofObject: stream. index := self fetchInteger: StreamIndexIndex ofObject: stream. limit := self fetchInteger: StreamReadLimitIndex ofObject: stream. atIx := (array bitAnd: AtCacheMask) + AtPutBase. (index < limit and: [(atCache at: atIx+AtCacheOop) = array]) ifFalse: [^self primitiveFail]. + ((self isOopImmutable: stream) + or: [self isOopImmutable: array]) ifTrue: - ((self internalIsMutable: stream) - and: [self internalIsMutable: array]) ifFalse: [^self primitiveFailFor: PrimErrNoModification]. "OK -- its not at end, and the array is in the cache" index := index + 1. self commonVariable: array at: index put: value cacheIndex: atIx. self successful ifTrue: [self storeInteger: StreamIndexIndex ofObject: stream withValue: index. ^ self pop: 2 thenPush: value]. ! Item was changed: ----- Method: NewspeakInterpreter>>primitiveObjectAtPut (in category 'object access primitives') ----- primitiveObjectAtPut "Defined for CompiledMethods only" + | rcvr index newValue | - | thisReceiver index newValue | newValue := self stackValue: 0. index := self stackIntegerValue: 1. self successful ifFalse: [^self primitiveFailFor: PrimErrBadArgument]. + rcvr := self stackValue: 2. + (index > 0 and: [index <= ((self literalCountOf: rcvr) + LiteralStart)]) ifFalse: - thisReceiver := self stackValue: 2. - (index > 0 and: [index <= ((self literalCountOf: thisReceiver) + LiteralStart)]) ifFalse: [^self primitiveFailFor: PrimErrBadIndex]. + (self isOopImmutable: rcvr) ifTrue: - (self internalIsMutable: thisReceiver) ifFalse: [^self primitiveFailFor: PrimErrNoModification]. + self storePointer: index - 1 ofObject: rcvr withValue: newValue. - self storePointer: index - 1 ofObject: thisReceiver withValue: newValue. self pop: 3 thenPush: newValue! Item was changed: ----- Method: NewspeakInterpreter>>primitiveShortAtPut (in category 'sound primitives') ----- primitiveShortAtPut "Treat the receiver, which can be indexible by either bytes or words, as an array of signed 16-bit values. Set the contents of the given index to the given value. Note that the index specifies the i-th 16-bit entry, not the i-th byte or word." | index rcvr sz addr value | value := self stackIntegerValue: 0. index := self stackIntegerValue: 1. (self successful and: [(value >= -32768) and: [value <= 32767]]) ifFalse: [^self primitiveFailFor: PrimErrBadArgument]. rcvr := self stackValue: 2. ((self isIntegerObject: rcvr) not and: [self isWordsOrBytes: rcvr]) ifFalse: [^self primitiveFailFor: PrimErrInappropriate]. sz := ((self sizeBitsOf: rcvr) - BaseHeaderSize) // 2. "number of 16-bit fields" (index >= 1 and: [index <= sz]) ifFalse: [^self primitiveFailFor: PrimErrBadIndex]. + (self isOopImmutable: rcvr) ifTrue: - (self internalIsMutable: rcvr) ifFalse: [^self primitiveFailFor: PrimErrNoModification]. addr := rcvr + BaseHeaderSize + (2 * (index - 1)). self shortAt: addr put: value. self pop: 3 thenPush: (self integerObjectOf: value) "pop all; return value"! Item was changed: ----- Method: NewspeakInterpreter>>storeAndPopReceiverVariableBytecode (in category 'stack bytecodes') ----- storeAndPopReceiverVariableBytecode "Note: This code uses storePointerUnchecked:ofObject:withValue: and does the store check explicitly in order to help the translator produce better code." | rcvr top | <expandCases> self cCode: "this bytecode will be expanded so that refs to currentBytecode below will be constant" [rcvr := receiver. top := self internalStackTop. + (self isObjImmutable: rcvr) ifTrue: - (self internalIsImmutable: rcvr) ifTrue: [self internalPop: 1. self internalCannotAssign: top to: receiver withIndex: (currentBytecode bitAnd: 7)]. "cannot fetch next bytecode until after immutability check so pc is correct (set to following bytecode, not the bytecode after that) after attemptToAssign:withIndex:" self fetchNextBytecode. rcvr < youngStart ifTrue: [self possibleRootStoreInto: rcvr value: top]. self storePointerUnchecked: (currentBytecode bitAnd: 7) ofObject: rcvr withValue: top. self internalPop: 1] inSmalltalk: "Interpreter version has fetchNextBytecode out of order" [rcvr := receiver. top := self internalStackTop. + (self isObjImmutable: rcvr) ifTrue: - (self internalIsImmutable: rcvr) ifTrue: [self internalPop: 1. self internalCannotAssign: top to: receiver withIndex: (currentBytecode bitAnd: 7)]. rcvr < youngStart ifTrue: [self possibleRootStoreInto: rcvr value: top]. self storePointerUnchecked: (currentBytecode bitAnd: 7) ofObject: rcvr withValue: top. self internalPop: 1. self fetchNextBytecode]! Item was changed: ----- Method: NewsqueakIA32ABIPlugin>>primAddressFieldPut (in category 'primitives-accessing') ----- primAddressFieldPut "Store an unsigned integer into the size field (the second 32 bit field; little endian)." "<Alien> addressFieldPut: value <Integer> ^<Integer> <primitive: 'primAddressFieldPut' error: errorCode module: 'IA32ABI'>" | rcvr value valueOop | <export: true> valueOop := interpreterProxy stackValue: 0. rcvr := interpreterProxy stackValue: 1. value := interpreterProxy positive32BitValueOf: valueOop. interpreterProxy failed ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. + (interpreterProxy isOopImmutable: rcvr) ifTrue: - (interpreterProxy internalIsImmutable: rcvr) ifTrue: [^interpreterProxy primitiveFailFor: PrimErrNoModification]. self longAt: rcvr + BaseHeaderSize + BytesPerOop put: value. ^interpreterProxy methodReturnValue: valueOop! Item was changed: ----- Method: NewsqueakIA32ABIPlugin>>primAlienReplace (in category 'primitives-accessing') ----- primAlienReplace "Copy some number of bytes from some source object starting at the index into the receiver destination object from startIndex to stopIndex . The source and destination may be Aliens or byte-indexable objects. The primitive wll have either of the following signatures: <Alien | indexableByteSubclass | indexableWordSubclass> primReplaceFrom: start <Integer> to: stop <Integer> with: replacement <Alien | indexableByteSubclass | indexableWordSubclass | Integer> startingAt: repStart <Integer> ^<self> <primitive: 'primitiveAlienReplace' error: errorCode module: 'IA32ABI'> <Anywhere> primReplaceIn: dest <Alien | indexableByteSubclass | indexableWordSubclass> from: start <Integer> to: stop <Integer> with: replacement <Alien | indexableByteSubclass | indexableWordSubclass | Integer> startingAt: repStart <Integer> ^<self> <primitive: 'primitiveAlienReplace' error: errorCode module: 'IA32ABI'> " | array start stop repl replStart dest src totalLength count | <export: true> array := interpreterProxy stackValue: 4. start := interpreterProxy stackIntegerValue: 3. stop := interpreterProxy stackIntegerValue: 2. repl := interpreterProxy stackValue: 1. replStart := interpreterProxy stackIntegerValue: 0. (interpreterProxy failed or: [(interpreterProxy isWordsOrBytes: array) not]) ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. (self isAlien: array) ifTrue: [totalLength := self sizeField: array. dest := (self startOfData: array withSize: totalLength) + start - 1. totalLength = 0 "no bounds checks for zero-sized (pointer) Aliens" ifTrue: [totalLength := stop] ifFalse: [totalLength := totalLength abs]] ifFalse: [totalLength := interpreterProxy byteSizeOf: array. dest := (self startOfByteData: array) + start - 1]. (start >= 1 and: [start - 1 <= stop and: [stop <= totalLength]]) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]. (interpreterProxy isIntegerObject: repl) ifTrue: [(interpreterProxy integerValueOf: repl) <= 0 ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. src := (interpreterProxy integerValueOf: repl) + replStart - 1] ifFalse: [(interpreterProxy fetchClassOf: repl) == interpreterProxy classLargePositiveInteger ifTrue: [src := (interpreterProxy positive32BitValueOf: repl) + replStart - 1. interpreterProxy failed ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]] ifFalse: [(self isAlien: repl) ifTrue: [totalLength := self sizeField: repl. src := (self startOfData: repl withSize: totalLength) + replStart - 1. totalLength = 0 "no bounds checks for zero-sized (pointer) Aliens" ifTrue: [totalLength := stop - start + replStart] ifFalse: [totalLength := totalLength abs]] ifFalse: [(interpreterProxy isWordsOrBytes: repl) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. totalLength := interpreterProxy byteSizeOf: repl. src := (self startOfByteData: repl) + replStart - 1]. (replStart >= 1 and: [stop - start + replStart <= totalLength]) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]]]. + (interpreterProxy isOopImmutable: array) ifTrue: - (interpreterProxy internalIsImmutable: array) ifTrue: [^interpreterProxy primitiveFailFor: PrimErrNoModification]. count := stop - start + 1. self cCode: 'memmove((void *)dest,(void *)src,count)' inSmalltalk: [count := count + src + dest. "squash unused var compiler warnings" self error: 'not implemented']. interpreterProxy pop: interpreterProxy methodArgumentCount! Item was changed: ----- Method: NewsqueakIA32ABIPlugin>>primDoubleAtPut (in category 'primitives-accessing') ----- primDoubleAtPut "Store a double into 64 bits starting at the given byte offset (little endian)." "<Alien> doubleAt: index <Integer> put: value <Float | Integer> ^<Float | Integer> <primitive: 'primDoubleAtPut' error: errorCode module: 'IA32ABI'>" | byteOffset rcvr startAddr addr valueOop floatValue | <export: true> <var: #floatValue type: #double> valueOop := interpreterProxy stackValue: 0. (interpreterProxy isIntegerObject: valueOop) ifTrue:[floatValue := self cCoerce: (interpreterProxy integerValueOf: valueOop) to: #double] ifFalse:[floatValue := self cCoerce: (interpreterProxy floatValueOf: valueOop) to: #double]. byteOffset := (interpreterProxy stackPositiveMachineIntegerValue: 1) - 1. rcvr := interpreterProxy stackObjectValue: 2. interpreterProxy failed ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. (self index: byteOffset length: 8 inRange: rcvr) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]. + (interpreterProxy isOopImmutable: rcvr) ifTrue: - (interpreterProxy internalIsImmutable: rcvr) ifTrue: [^interpreterProxy primitiveFailFor: PrimErrNoModification]. (startAddr := self startOfData: rcvr) = 0 ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadReceiver]. addr := startAddr + byteOffset. self cCode:'((int*)addr)[0] = ((int*)(&floatValue))[0]'. self cCode:'((int*)addr)[1] = ((int*)(&floatValue))[1]'. interpreterProxy methodReturnValue: valueOop! Item was changed: ----- Method: NewsqueakIA32ABIPlugin>>primFloatAtPut (in category 'primitives-accessing') ----- primFloatAtPut "Store a float into 32 bits starting at the given byte offset (little endian)." "<Alien> floatAt: index <Integer> put: value <Float | Integer> ^<Float | Integer> <primitive: 'primFloatAtPut' error: errorCode module: 'IA32ABI'>" | byteOffset rcvr startAddr addr valueOop floatValue | <export: true> <var: #floatValue type: #float> valueOop := interpreterProxy stackValue: 0. (interpreterProxy isIntegerObject: valueOop) ifTrue:[floatValue := self cCoerce: (interpreterProxy integerValueOf: valueOop) to: #double] ifFalse:[floatValue := self cCoerce: (interpreterProxy floatValueOf: valueOop) to: #double]. byteOffset := (interpreterProxy stackPositiveMachineIntegerValue: 1) - 1. rcvr := interpreterProxy stackObjectValue: 2. interpreterProxy failed ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. (self index: byteOffset length: 4 inRange: rcvr) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]. + (interpreterProxy isOopImmutable: rcvr) ifTrue: - (interpreterProxy internalIsImmutable: rcvr) ifTrue: [^interpreterProxy primitiveFailFor: PrimErrNoModification]. (startAddr := self startOfData: rcvr) = 0 ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadReceiver]. addr := startAddr + byteOffset. self cCode:'((long *)addr)[0] = ((long *)(&floatValue))[0]'. interpreterProxy methodReturnValue: valueOop! Item was changed: ----- Method: NewsqueakIA32ABIPlugin>>primSignedByteAtPut (in category 'primitives-accessing') ----- primSignedByteAtPut "Store a signed integer into 8 bits starting at the given byte offset (little endian)." "<Alien> signedByteAt: index <Integer> put: value <Integer> ^<Integer> <primitive: 'primSignedByteAtPut' error: errorCode module: 'IA32ABI'>" | byteOffset rcvr startAddr addr value valueOop | <export: true> valueOop := interpreterProxy stackValue: 0. byteOffset := (interpreterProxy stackPositiveMachineIntegerValue: 1) - 1. rcvr := interpreterProxy stackObjectValue: 2. value := interpreterProxy signed32BitValueOf: valueOop. (interpreterProxy failed or: [value < -128 or: [value > 127]]) ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. (self index: byteOffset length: 1 inRange: rcvr) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]. + (interpreterProxy isOopImmutable: rcvr) ifTrue: - (interpreterProxy internalIsImmutable: rcvr) ifTrue: [^interpreterProxy primitiveFailFor: PrimErrNoModification]. (startAddr := self startOfData: rcvr) = 0 ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadReceiver]. addr := startAddr + byteOffset. self byteAt: addr put: value. ^interpreterProxy methodReturnValue: valueOop! Item was changed: ----- Method: NewsqueakIA32ABIPlugin>>primSignedLongAtPut (in category 'primitives-accessing') ----- primSignedLongAtPut "Store a signed integer into 32 bits starting at the given byte offset (little endian)." "<Alien> signedLongAt: index <Integer> put: value <Integer> ^<Integer> <primitive: 'primSignedLongAtPut' error: errorCode module: 'IA32ABI'>" | byteOffset rcvr startAddr addr value valueOop | <export: true> valueOop := interpreterProxy stackValue: 0. byteOffset := (interpreterProxy stackPositiveMachineIntegerValue: 1) - 1. rcvr := interpreterProxy stackObjectValue: 2. value := interpreterProxy signed32BitValueOf: valueOop. interpreterProxy failed ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. (self index: byteOffset length: 4 inRange: rcvr) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]. + (interpreterProxy isOopImmutable: rcvr) ifTrue: - (interpreterProxy internalIsImmutable: rcvr) ifTrue: [^interpreterProxy primitiveFailFor: PrimErrNoModification]. (startAddr := self startOfData: rcvr) = 0 ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadReceiver]. addr := startAddr + byteOffset. self longAt: addr put: value. ^interpreterProxy methodReturnValue: valueOop! Item was changed: ----- Method: NewsqueakIA32ABIPlugin>>primSignedLongLongAtPut (in category 'primitives-accessing') ----- primSignedLongLongAtPut "Store a signed integer into 64 bits starting at the given byte offset (little endian)." "<Alien> signedLongLongAt: index <Integer> put: value <Integer> ^<Integer> <primitive: 'primSignedLongLongAtPut' error: errorCode module: 'IA32ABI'>" | byteOffset rcvr startAddr addr valueOop signedlonglongvalue signedlonglongvaluePtr | <export: true> <var: 'signedlonglongvalue' declareC: 'long long signedlonglongvalue'> <var: 'signedlonglongvaluePtr' declareC: 'long long *signedlonglongvaluePtr'> signedlonglongvaluePtr := 0. self touch: signedlonglongvaluePtr. valueOop := interpreterProxy stackValue: 0. byteOffset := (interpreterProxy stackPositiveMachineIntegerValue: 1) - 1. rcvr := interpreterProxy stackObjectValue: 2. signedlonglongvalue := interpreterProxy signed64BitValueOf: valueOop. self touch: signedlonglongvalue. interpreterProxy failed ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. (self index: byteOffset length: 8 inRange: rcvr) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]. + (interpreterProxy isOopImmutable: rcvr) ifTrue: - (interpreterProxy internalIsImmutable: rcvr) ifTrue: [^interpreterProxy primitiveFailFor: PrimErrNoModification]. (startAddr := self startOfData: rcvr) = 0 ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadReceiver]. addr := startAddr + byteOffset. signedlonglongvaluePtr := self cCoerce: addr to: 'long long*'. self cCode: '*signedlonglongvaluePtr = signedlonglongvalue'. ^interpreterProxy methodReturnValue: valueOop! Item was changed: ----- Method: NewsqueakIA32ABIPlugin>>primSignedShortAtPut (in category 'primitives-accessing') ----- primSignedShortAtPut "Store a signed integer into 16 bits starting at the given byte offset (little endian)." "<Alien> signedShortAt: index <Integer> put: value <Integer> ^<Integer> <primitive: 'primSignedShortAtPut' error: errorCode module: 'IA32ABI'>" | byteOffset rcvr startAddr addr value valueOop | <export: true> valueOop := interpreterProxy stackValue: 0. byteOffset := (interpreterProxy stackPositiveMachineIntegerValue: 1) - 1. rcvr := interpreterProxy stackObjectValue: 2. value := interpreterProxy signed32BitValueOf: valueOop. (interpreterProxy failed or: [value < -32768 or: [value > 32767]]) ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. (self index: byteOffset length: 2 inRange: rcvr) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]. + (interpreterProxy isOopImmutable: rcvr) ifTrue: - (interpreterProxy internalIsImmutable: rcvr) ifTrue: [^interpreterProxy primitiveFailFor: PrimErrNoModification]. (startAddr := self startOfData: rcvr) = 0 ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadReceiver]. addr := startAddr + byteOffset. self shortAt: addr put: value. ^interpreterProxy methodReturnValue: valueOop! Item was changed: ----- Method: NewsqueakIA32ABIPlugin>>primSizeFieldPut (in category 'primitives-accessing') ----- primSizeFieldPut "Store a signed integer into the size field (the first 32 bit field; little endian)." "<Alien> sizeFieldPut: value <Integer> ^<Integer> <primitive: 'primSizeFieldPut' error: errorCode module: 'IA32ABI'>" | rcvr value valueOop | <export: true> valueOop := interpreterProxy stackValue: 0. rcvr := interpreterProxy stackValue: 1. value := interpreterProxy signed32BitValueOf: valueOop. interpreterProxy failed ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. + (interpreterProxy isOopImmutable: rcvr) ifTrue: - (interpreterProxy internalIsImmutable: rcvr) ifTrue: [^interpreterProxy primitiveFailFor: PrimErrNoModification]. self longAt: rcvr + BaseHeaderSize put: value. ^interpreterProxy methodReturnValue: valueOop! Item was changed: ----- Method: NewsqueakIA32ABIPlugin>>primUnsignedByteAtPut (in category 'primitives-accessing') ----- primUnsignedByteAtPut "Store an unsigned integer into 8 bits starting at the given byte offset (little endian)." "<Alien> unsignedByteAt: index <Integer> put: value <Integer> ^<Integer> <primitive: 'primUnsignedByteAtPut' error: errorCode module: 'IA32ABI'>" | byteOffset rcvr startAddr addr value valueOop | <export: true> valueOop := interpreterProxy stackValue: 0. byteOffset := (interpreterProxy stackPositiveMachineIntegerValue: 1) - 1. rcvr := interpreterProxy stackObjectValue: 2. value := interpreterProxy positive32BitValueOf: valueOop. (interpreterProxy failed or: [value > 255]) ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. (self index: byteOffset length: 1 inRange: rcvr) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]. + (interpreterProxy isOopImmutable: rcvr) ifTrue: - (interpreterProxy internalIsImmutable: rcvr) ifTrue: [^interpreterProxy primitiveFailFor: PrimErrNoModification]. (startAddr := self startOfData: rcvr) = 0 ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadReceiver]. addr := startAddr + byteOffset. self byteAt: addr put: value. ^interpreterProxy methodReturnValue: valueOop! Item was changed: ----- Method: NewsqueakIA32ABIPlugin>>primUnsignedLongAtPut (in category 'primitives-accessing') ----- primUnsignedLongAtPut "Store an unsigned integer into 32 bits starting at the given byte offset (little endian)." "<Alien> unsignedLongAt: index <Integer> put: value <Integer> ^<Integer> <primitive: 'primUnsignedLongAtPut' error: errorCode module: 'IA32ABI'>" | byteOffset rcvr startAddr addr value valueOop | <export: true> valueOop := interpreterProxy stackValue: 0. byteOffset := (interpreterProxy stackPositiveMachineIntegerValue: 1) - 1. rcvr := interpreterProxy stackObjectValue: 2. value := interpreterProxy positive32BitValueOf: valueOop. interpreterProxy failed ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. (self index: byteOffset length: 4 inRange: rcvr) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]. + (interpreterProxy isOopImmutable: rcvr) ifTrue: - (interpreterProxy internalIsImmutable: rcvr) ifTrue: [^interpreterProxy primitiveFailFor: PrimErrNoModification]. (startAddr := self startOfData: rcvr) = 0 ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadReceiver]. addr := startAddr + byteOffset. self longAt: addr put: value. ^interpreterProxy methodReturnValue: valueOop! Item was changed: ----- Method: NewsqueakIA32ABIPlugin>>primUnsignedLongLongAtPut (in category 'primitives-accessing') ----- primUnsignedLongLongAtPut "Store a signed integer into 64 bits starting at the given byte offset (little endian)." "<Alien> unsignedLongLongAt: index <Integer> put: value <Integer> ^<Integer> <primitive: 'primUnSignedLongLongAtPut' error: errorCode module: 'IA32ABI'>" | byteOffset rcvr startAddr addr valueOop unsignedlonglongvalue unsignedlonglongvaluePtr | <export: true> <var: 'unsignedlonglongvalue' declareC: 'unsigned long long unsignedlonglongvalue'> <var: 'unsignedlonglongvaluePtr' declareC: 'unsigned long long *unsignedlonglongvaluePtr'> unsignedlonglongvaluePtr := 0. self touch: unsignedlonglongvaluePtr. valueOop := interpreterProxy stackValue: 0. byteOffset := (interpreterProxy stackPositiveMachineIntegerValue: 1) - 1. rcvr := interpreterProxy stackObjectValue: 2. unsignedlonglongvalue := interpreterProxy positive64BitValueOf: valueOop. self touch: unsignedlonglongvalue. interpreterProxy failed ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. (self index: byteOffset length: 8 inRange: rcvr) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]. + (interpreterProxy isOopImmutable: rcvr) ifTrue: - (interpreterProxy internalIsImmutable: rcvr) ifTrue: [^interpreterProxy primitiveFailFor: PrimErrNoModification]. (startAddr := self startOfData: rcvr) = 0 ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadReceiver]. addr := startAddr + byteOffset. unsignedlonglongvaluePtr := self cCoerce: addr to: 'unsigned long long*'. self cCode: '*unsignedlonglongvaluePtr = unsignedlonglongvalue'. ^interpreterProxy methodReturnValue: valueOop! Item was changed: ----- Method: NewsqueakIA32ABIPlugin>>primUnsignedShortAtPut (in category 'primitives-accessing') ----- primUnsignedShortAtPut "Store an unsigned integer into 16 bits starting at the given byte offset (little endian)." "<Alien> unsignedShortAt: index <Integer> put: value <Integer> ^<Integer> <primitive: 'primUnsignedShortAtPut' error: errorCode module: 'IA32ABI'>" | byteOffset rcvr startAddr addr value valueOop | <export: true> valueOop := interpreterProxy stackValue: 0. byteOffset := (interpreterProxy stackPositiveMachineIntegerValue: 1) - 1. rcvr := interpreterProxy stackObjectValue: 2. value := interpreterProxy positive32BitValueOf: valueOop. (interpreterProxy failed or: [value > 65535]) ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. (self index: byteOffset length: 2 inRange: rcvr) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]. + (interpreterProxy isOopImmutable: rcvr) ifTrue: - (interpreterProxy internalIsImmutable: rcvr) ifTrue: [^interpreterProxy primitiveFailFor: PrimErrNoModification]. (startAddr := self startOfData: rcvr) = 0 ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadReceiver]. addr := startAddr + byteOffset. self shortAt: addr put: value. ^interpreterProxy methodReturnValue: valueOop! Item was changed: ----- Method: ObjectMemory>>containOnlyMutableOops:and: (in category 'become') ----- containOnlyMutableOops: array1 and: array2 "Return true if neither array contains an immutable. You may not be allowed to become: immutables." | fieldOffset | fieldOffset := self lastPointerOf: array1. "same size as array2" [fieldOffset >= BaseHeaderSize] whileTrue: + [(self isOopImmutable: (self longAt: array1 + fieldOffset)) ifTrue: [^false]. + (self isOopImmutable: (self longAt: array2 + fieldOffset)) ifTrue: [^false]. - [(self internalIsImmutable: (self longAt: array1 + fieldOffset)) ifTrue: [^ false]. - (self internalIsImmutable: (self longAt: array2 + fieldOffset)) ifTrue: [^ false]. fieldOffset := fieldOffset - BytesPerWord]. + ^true! - ^ true! Item was added: + ----- Method: ObjectMemory>>isObjImmutable: (in category 'header access') ----- + isObjImmutable: anOop + <inline: true> + ^self cppIf: IMMUTABILITY + ifTrue: [((self baseHeader: anOop) bitAnd: ImmutabilityBit hex) ~= 0] + ifFalse: [false]! Item was added: + ----- Method: ObjectMemory>>isObjMutable: (in category 'header access') ----- + isObjMutable: anOop + <inline: true> + ^(self isObjImmutable: anOop) not! Item was added: + ----- Method: ObjectMemory>>isOopImmutable: (in category 'header access') ----- + isOopImmutable: anOop + <api> + ^(self isIntegerObject: anOop) + or: [self isObjImmutable: anOop]! Item was added: + ----- Method: ObjectMemory>>isOopMutable: (in category 'header access') ----- + isOopMutable: anOop + <api> + ^(self isIntegerObject: anOop) not + and: [(self isObjImmutable: anOop) not]! Item was changed: ----- Method: StackInterpreter class>>initializePrimitiveTable (in category 'initialization') ----- (excessive size, no diff calculated) Item was removed: - ----- Method: StackInterpreter>>internalIsImmutable: (in category 'object format') ----- - internalIsImmutable: oop - <option: #NewspeakVM> - <inline: true> - <export: true> - ^((objectMemory baseHeader: oop) bitAnd: ImmutabilityBit) ~= 0!

1 0

VM Maker: VMMaker.oscog-eem.230.mcz
by commits＠source.squeak.org 12 Dec '12

12 Dec '12

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.230.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.230 Author: eem Time: 11 December 2012, 3:16:18.03 pm UUID: 735cb4f0-6d2a-4916-bbd0-cd517917da4e Ancestors: VMMaker.oscog-eem.229 Fix stackPage headroom calculation in CoInterpreter. Was getting things backward. This increases the stack page headroom by 62% from 1564 bytes to 2532 bytes. Shootout benchmarks unchanged, so reduction in frames per page is not an issue for typical code. This should result in fewer crashes on linux where the dynamic linker, if it kicked in during a signal handler, could cause a deep call chain at interrupt time and trample the start of the adjoining stack page. Use self alloca: nbytes over cCode: 'alloca(nbytes)' =============== Diff against VMMaker.oscog-eem.229 =============== Item was changed: ----- Method: CoInterpreter>>initStackPagesAndInterpret (in category 'initialization') ----- initStackPagesAndInterpret "Initialize the stack pages and enter interpret. Use alloca'ed memory so that when we have a JIT its stack pointer will be on the native stack since alloca allocates memory on the stack. Certain thread systems use the native stack pointer as the frame ID so putting the stack anywhere else can confuse the thread system." "Override to establish the setjmp/longjmp handler for reentering the interpreter from machine code, and disable executablity on the heap and stack pages." "This should be in its own initStackPages method but Slang can't inline C code strings." | stackPageBytes stackPagesBytes theStackMemory | <var: #theStackMemory type: #'char *'> stackPageBytes := self stackPageByteSize. stackPagesBytes := self computeStackZoneSize. theStackMemory := self + cCode: [self alloca: stackPagesBytes] - cCode: 'alloca(stackPagesBytes)' inSmalltalk: [stackPages := self stackPagesClass new. stackPages initializeWithByteSize: stackPagesBytes for: self]. self sqMakeMemoryNotExecutableFrom: objectMemory startOfMemory asUnsignedInteger To: objectMemory memoryLimit asUnsignedInteger. self sqMakeMemoryNotExecutableFrom: theStackMemory asUnsignedInteger To: theStackMemory asUnsignedInteger + stackPagesBytes. stackPages initializeStack: theStackMemory numSlots: stackPagesBytes / BytesPerWord pageSize: stackPageBytes / BytesPerWord stackLimitOffset: self stackLimitOffset stackPageHeadroom: self stackPageHeadroom. "Once the stack pages are initialized we can continue to bootstrap the system." self loadInitialContext. "We're ready for the heartbeat (poll interrupt)" self ioInitHeartbeat. self initialEnterSmalltalkExecutive. ^nil! Item was changed: ----- Method: CoInterpreterStackPages>>initializeStack:numSlots:pageSize:stackLimitOffset:stackPageHeadroom: (in category 'initialization') ----- initializeStack: theStackPages numSlots: stackSlots pageSize: slotsPerPage stackLimitOffset: stackLimitOffsetBytes stackPageHeadroom: stackPageHeadroomBytes "Initialize the stack pages. In the C VM theStackPages will be alloca'ed memory to hold the stack pages on the C stack. In the simulator they are housed in the memory between the cogMethodZone and the heap." <var: #theStackPages type: #'char *'> <returnTypeC: #void> | numPages page structStackPageSize pageStructBase count | <var: #page type: #'StackPage *'> <var: #pageStructBase type: #'char *'> + self cCode: [] - self cCode: '' inSmalltalk: [self assert: objectMemory startOfMemory - coInterpreter cogCodeSize - coInterpreter methodCacheSize - coInterpreter primTraceLogSize - coInterpreter rumpCStackSize = (stackSlots * BytesPerWord)]. structStackPageSize := coInterpreter sizeof: CogStackPage. bytesPerPage := slotsPerPage * BytesPerWord. numPages := coInterpreter numStkPages. "Because stack pages grow down baseAddress is at the top of a stack page and so to avoid subtracting BytesPerWord from baseAddress and lastAddress in the init loop below we simply push the stackPage array up one word to avoid the overlap. This word is extraStackBytes." pageStructBase := theStackPages + (numPages * bytesPerPage) + BytesPerWord. pages := self cCode: [self cCoerceSimple: pageStructBase to: #'StackPage *'] inSmalltalk: [pageMap := Dictionary new. ((0 to: numPages - 1) collect: [:i| CogStackPage surrogateClass new address: pageStructBase + (i * structStackPageSize) simulator: coInterpreter zoneBase: coInterpreter stackZoneBase zoneLimit: objectMemory startOfMemory]) do: [:pageSurrogate| pageMap at: pageSurrogate address put: pageSurrogate]; yourself]. 0 to: numPages - 1 do: [:index| page := self stackPageAt: index. page lastAddress: theStackPages + (index * bytesPerPage); + baseAddress: page lastAddress + bytesPerPage; + stackLimit: page baseAddress + - stackLimitOffsetBytes + - stackPageHeadroomBytes; - baseAddress: (page lastAddress + bytesPerPage); - stackLimit: page lastAddress - + stackLimitOffsetBytes - + stackPageHeadroomBytes; realStackLimit: page stackLimit; baseFP: 0; nextPage: (self stackPageAt: (index = (numPages - 1) ifTrue: [0] ifFalse: [index + 1])); prevPage: (self stackPageAt: (index = 0 ifTrue: [numPages - 1] ifFalse: [index - 1]))]. "Now compute stackBasePlus1 so that the pageIndexFor: call maps all addresses from aPage baseAddress to aBase limitAddress + 1 to the same index (stacks grow down)" stackBasePlus1 := (self cCoerceSimple: theStackPages to: #'char *') + 1. + self cCode: [] - self cCode: '' inSmalltalk: [minStackAddress := theStackPages. maxStackAddress := theStackPages + (numPages * bytesPerPage) + BytesPerWord - 1]. "The overflow limit is the amount of stack to retain when moving frames from an overflowing stack to reduce thrashing. See stackOverflowOrEvent:mayContextSwitch:" page := self stackPageAt: 0. overflowLimit := page baseAddress - page realStackLimit * 3 // 5. 0 to: numPages - 1 do: [:index| page := self stackPageAt: index. self assert: (self pageIndexFor: page baseAddress) == index. self assert: (self pageIndexFor: page baseAddress - (slotsPerPage - 1 * BytesPerWord)) == index. self assert: (self stackPageFor: page baseAddress) == page. self assert: (self stackPageFor: page stackLimit) == page. + self cCode: [] - self cCode: '' inSmalltalk: [| memIndex | memIndex := index * slotsPerPage + 1. "this is memIndex in the block above" self assert: (self memIndexFor: (self oopForPointer: page baseAddress)) == (memIndex + slotsPerPage - 1). index < (numPages - 1) ifTrue: [self assert: (self stackPageFor: page baseAddress + BytesPerWord) == (self stackPageAt: index + 1)]]. self assert: (page trace: -1) ~= 0 "for assert checking of the page tracing flags. -1 == invalid state"]. mostRecentlyUsedPage := self stackPageAt: 0. page := mostRecentlyUsedPage. count := 0. [| theIndex | count := count + 1. theIndex := self pageIndexFor: page baseAddress. self assert: (self stackPageAt: theIndex) == page. self assert: (self pageIndexFor: page baseAddress) == theIndex. self assert: (self pageIndexFor: page stackLimit) == theIndex. self assert: (self pageIndexFor: page lastAddress + 1) == theIndex. (page := page nextPage) ~= mostRecentlyUsedPage] whileTrue. self assert: count == numPages. self assert: self pageListIsWellFormed! Item was changed: ----- Method: StackInterpreter>>initStackPages (in category 'initialization') ----- initStackPages "Initialize the stackPages. This version is only for simulation because Slang refuses to inline it, which makes the alloca invalid." | stackPageBytes stackPagesBytes theStackMemory | stackPageBytes := self stackPageByteSize. stackPagesBytes := self computeStackZoneSize. theStackMemory := self + cCode: [self alloca: stackPagesBytes] - cCode: 'alloca(stackPagesBytes)' inSmalltalk: [stackPages := self stackPagesClass new. stackPages initializeWithByteSize: stackPagesBytes for: self]. stackPages initializeStack: theStackMemory numSlots: stackPagesBytes / BytesPerWord pageSize: stackPageBytes / BytesPerWord stackLimitOffset: self stackLimitOffset stackPageHeadroom: self stackPageHeadroom! Item was changed: ----- Method: StackInterpreter>>initStackPagesAndInterpret (in category 'initialization') ----- initStackPagesAndInterpret "Initialize the stack pages and enter interpret. Use alloca'ed memory so that when we have a JIT its stack pointer will be on the native stack since alloca allocates memory on the stack. Certain thread systems use the native stack pointer as the frame ID so putting the stack anywhere else can confuse the thread system." "This should be in its own initStackPages method but Slang can't inline C code strings." | stackPageBytes stackPagesBytes theStackMemory | <var: #theStackMemory type: #'void *'> stackPageBytes := self stackPageByteSize. stackPagesBytes := self computeStackZoneSize. theStackMemory := self + cCode: [self alloca: stackPagesBytes] - cCode: 'alloca(stackPagesBytes)' inSmalltalk: [stackPages := self stackPagesClass new. stackPages initializeWithByteSize: stackPagesBytes for: self]. stackPages initializeStack: theStackMemory numSlots: stackPagesBytes / BytesPerWord pageSize: stackPageBytes / BytesPerWord stackLimitOffset: self stackLimitOffset stackPageHeadroom: self stackPageHeadroom. "Once the stack pages are initialized we can continue to bootstrap the system." self loadInitialContext. "We're ready for the heartbeat (poll interrupt)" self ioInitHeartbeat. self interpret. ^nil! Item was removed: - ----- Method: ThreadedFFIPlugin>>alloca: (in category 'simulation') ----- - alloca: size - <doNotGenerate> - ^ByteArray new: size! Item was added: + ----- Method: VMClass>>alloca: (in category 'C library simulation') ----- + alloca: size + "Simulation of alloca(3)" + <doNotGenerate> + ^ByteArray new: size!

1 0

VM Maker: VMMaker.oscog-eem.229.mcz
by commits＠source.squeak.org 11 Dec '12

11 Dec '12

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.229.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.229 Author: eem Time: 11 December 2012, 2:03:55.958 pm UUID: d0568065-8deb-4e6e-8c98-798d0983ef52 Ancestors: VMMaker.oscog-eem.228 Streamline ObjectMemory>>instantiateClass:indexableSize: (hdrSize and header3 change together). Optimize the debug VM by making startOfMemory a macro that answers heapBase instead of a method. Improve stack page printing, and make stack trace printing more robust (findClass/SelectorOfMethod:forReceiver:). Make temporary:in:put: et al answer their values. For stObject:at:put:. Remove dead code in TMethod (typedByPropagation). make jumpTable size err message more explanatory. typos. =============== Diff against VMMaker.oscog-eem.228 =============== Item was changed: ----- Method: CoInterpreter>>itemporary:in:put: (in category 'internal interpreter access') ----- itemporary: offset in: theFP put: valueOop "Temporary access for an interpreter frame only." "See StackInterpreter class>>initializeFrameIndices" | frameNumArgs | <inline: true> <var: #theFP type: #'char *'> + ^offset < (frameNumArgs := self iframeNumArgs: theFP) - offset < (frameNumArgs := self iframeNumArgs: theFP) ifTrue: [stackPages longAt: theFP + FoxCallerSavedIP + ((frameNumArgs - offset) * BytesPerWord) put: valueOop] ifFalse: [stackPages longAt: theFP + FoxIFReceiver - BytesPerWord + ((frameNumArgs - offset) * BytesPerWord) put: valueOop]! Item was changed: ----- Method: CoInterpreter>>mtemporary:in:put: (in category 'internal interpreter access') ----- mtemporary: offset in: theFP put: valueOop "Temporary access for a machine code frame only." "See StackInterpreter class>>initializeFrameIndices" | frameNumArgs | <inline: true> <var: #theFP type: #'char *'> + ^stackPages - stackPages longAt: (offset < (frameNumArgs := self mframeNumArgs: theFP) ifTrue: [theFP + FoxCallerSavedIP + ((frameNumArgs - offset) * BytesPerWord)] ifFalse: [theFP + FoxMFReceiver - BytesPerWord + ((frameNumArgs - offset) * BytesPerWord)]) put: valueOop! Item was changed: ----- Method: CoInterpreter>>temporary:in:put: (in category 'internal interpreter access') ----- temporary: offset in: theFP put: valueOop <inline: true> + ^(self isMachineCodeFrame: theFP) - (self isMachineCodeFrame: theFP) ifTrue: [self mtemporary: offset in: theFP put: valueOop] ifFalse: [self itemporary: offset in: theFP put: valueOop]! Item was changed: ----- Method: CogObjectRepresentationForSqueakV3>>couldBeObject: (in category 'garbage collection') ----- couldBeObject: oop ^(objectMemory isNonIntegerObject: oop) + and: [oop asUnsignedInteger >= objectMemory nilObject]! - and: [oop asUnsignedInteger > objectMemory startOfMemory]! Item was changed: ----- Method: Cogit>>lookup:for:methodAndErrorSelectorInto: (in category 'in-line cacheing') ----- lookup: selector for: receiver methodAndErrorSelectorInto: binaryBlock "Lookup selector in the class of receiver. If found, evaluate binaryBlock with the method, cogged if appropriate.. If not found, due to MNU, lookup the DNU selector and evaluate binaryBlock with the MNU method, cogged if appropriate.. If not found due to cannot interpret, evaluate binaryBlock with a nil method and the error selector." | methodOrSelectorIndex | <inline: true> methodOrSelectorIndex := coInterpreter lookup: selector receiver: receiver. + methodOrSelectorIndex asUnsignedInteger >= objectMemory nilObject ifTrue: - methodOrSelectorIndex asUnsignedInteger > objectMemory startOfMemory ifTrue: [(objectMemory isOopCompiledMethod: methodOrSelectorIndex) ifFalse: [^binaryBlock value: methodOrSelectorIndex value: SelectorCannotInterpret]. ((coInterpreter methodHasCogMethod: methodOrSelectorIndex) not and: [coInterpreter methodShouldBeCogged: methodOrSelectorIndex]) ifTrue: ["We assume cog:selector: will *not* reclaim the method zone" self cog: methodOrSelectorIndex selector: selector]. ^binaryBlock value: methodOrSelectorIndex value: nil]. methodOrSelectorIndex = SelectorDoesNotUnderstand ifTrue: [methodOrSelectorIndex := coInterpreter lookup: (objectMemory splObj: SelectorDoesNotUnderstand) receiver: receiver. + methodOrSelectorIndex asUnsignedInteger >= objectMemory nilObject ifTrue: - methodOrSelectorIndex asUnsignedInteger > objectMemory startOfMemory ifTrue: [self assert: (objectMemory isOopCompiledMethod: methodOrSelectorIndex). ((coInterpreter methodHasCogMethod: methodOrSelectorIndex) not and: [coInterpreter methodShouldBeCogged: methodOrSelectorIndex]) ifTrue: ["We assume cog:selector: will *not* reclaim the method zone" self cog: methodOrSelectorIndex selector: selector]. ^binaryBlock value: methodOrSelectorIndex value: SelectorDoesNotUnderstand]. ^binaryBlock value: nil value: SelectorDoesNotUnderstand]. ^binaryBlock value: nil value: methodOrSelectorIndex! Item was changed: ----- Method: Gnuifier>>gnuifyFrom:to: (in category 'as yet unclassified') ----- gnuifyFrom: inFileStream to: outFileStream "convert interp.c to use GNU features" | inData beforeInterpret inInterpret inInterpretVars beforePrimitiveResponse inPrimitiveResponse | inData := inFileStream upToEnd withSqueakLineEndings. inFileStream close. "print a header" outFileStream nextPutAll: '/* This file has been post-processed for GNU C */'; cr; cr; cr. beforeInterpret := true. "whether we are before the beginning of interpret()" inInterpret := false. "whether we are in the middle of interpret" inInterpretVars := false. "whether we are in the variables of interpret" beforePrimitiveResponse := true. "whether we are before the beginning of primitiveResponse()" inPrimitiveResponse := false. "whether we are inside of primitiveResponse" 'Gnuifying' displayProgressAt: Sensor cursorPoint from: 1 to: (inData occurrencesOf: Character cr) during: [:bar | | lineNumber | lineNumber := 0. inData linesDo: [ :inLine | | outLine extraOutLine | bar value: (lineNumber := lineNumber + 1). outLine := inLine. "print out one line for each input line; by default, print out the line that was input, but some rules modify it" extraOutLine := nil. "occasionally print a second output line..." beforeInterpret ifTrue: [ (inLine = '#include "sq.h"') ifTrue: [ outLine := '#include "sqGnu.h"'. ]. (inLine beginsWith: 'interpret(void)') ifTrue: [ "reached the beginning of interpret" beforeInterpret := false. inInterpret := true. inInterpretVars := true. ] ] ifFalse: [ inInterpretVars ifTrue: [ (inLine findString: 'register struct foo * foo = &fum;') > 0 ifTrue: [ outLine := 'register struct foo * foo FOO_REG = &fum;' ]. (inLine findString: ' localIP;') > 0 ifTrue: [ outLine := ' register char* localIP IP_REG;' ]. (inLine findString: ' localFP;') > 0 ifTrue: [ outLine := ' register char* localFP FP_REG;' ]. (inLine findString: ' localSP;') > 0 ifTrue: [ outLine := ' register char* localSP SP_REG;' ]. (inLine findString: ' currentBytecode;') > 0 ifTrue: [ outLine := ' register sqInt currentBytecode CB_REG;' ]. inLine isEmpty ifTrue: [ "reached end of variables" inInterpretVars := false. outLine := ' JUMP_TABLE;'. + extraOutLine := '\#if MULTIPLEBYTECODESETS\ if(!!asserta((sizeof(jumpTable)/sizeof(jumpTable[0])) >= 512))\ error("bytecode jumpTable too small");\#endif\' withCRs]] - extraOutLine := '\#if MULTIPLEBYTECODESETS\ if(!!asserta((sizeof(jumpTable)/sizeof(jumpTable[0])) >= 512))\ error("jumpTable too small");\#endif\' withCRs]] ifFalse: [ inInterpret ifTrue: [ "working inside interpret(); translate the switch statement" (inLine beginsWith: ' case ') ifTrue: [ | tokens | tokens := inLine findTokens: ' :'. outLine := ' CASE(', tokens second, ')'. tokens size > 2 ifTrue: [(tokens allButFirst: 2) do: [:token| outLine := outLine, ' ', token]]]. inLine = ' break;' ifTrue: [ outLine := ' BREAK;' ]. inLine = '}' ifTrue: [ "all finished with interpret()" inInterpret := false. ] ] ifFalse: [ beforePrimitiveResponse ifTrue: [ (inLine beginsWith: 'primitiveResponse(') ifTrue: [ "into primitiveResponse we go" beforePrimitiveResponse := false. inPrimitiveResponse := true. extraOutLine := ' PRIM_TABLE;'. ] ] ifFalse: [ inPrimitiveResponse ifTrue: [ (inLine = ' switch (primitiveIndex) {') ifTrue: [ extraOutLine := outLine. outLine := ' PRIM_DISPATCH;' ]. (inLine = ' switch (GIV(primitiveIndex)) {') ifTrue: [ extraOutLine := outLine. outLine := ' PRIM_DISPATCH;' ]. (inLine beginsWith: ' case ') ifTrue: [ | caseLabel | caseLabel := (inLine findTokens: ' :') second. outLine := ' CASE(', caseLabel, ')' ]. inLine = '}' ifTrue: [ inPrimitiveResponse := false ] ]. ] ] ] ]. outFileStream nextPutAll: outLine; cr. extraOutLine ifNotNil: [ outFileStream nextPutAll: extraOutLine; cr ]]]. outFileStream close! Item was changed: ----- Method: NewCoObjectMemory>>startOfMemory (in category 'accessing') ----- startOfMemory "Return the start of object memory. This is immediately after the native code zone. + N.B. the stack zone is alloca'ed. Use a macro so as not to punish the debug VM." + <cmacro: '() heapBase'> - N.B. the stack zone is alloca'ed." - <api> <returnTypeC: #usqInt> ^coInterpreter heapBase! Item was changed: ----- Method: ObjectMemory>>instantiateClass:indexableSize: (in category 'interpreter access') ----- instantiateClass: classPointer indexableSize: size "NOTE: This method supports the backward-compatible split instSize field of the class format word. The sizeHiBits will go away and other shifts change by 2 when the split fields get merged in an (incompatible) image change." <api> + | hash header1 header2 cClass byteSize format binc header3 hdrSize sizeHiBits bm1 classFormat | - | hash header1 header2 cClass byteSize format binc header3 hdrSize newObj sizeHiBits bm1 classFormat | <inline: false> self assert: size >= 0. "'cannot have a negative indexable field count" hash := self newObjectHash. classFormat := self formatOfClass: classPointer. "Low 2 bits are 0" header1 := (classFormat bitAnd: 16r1FF00) bitOr: (hash bitAnd: HashMaskUnshifted) << HashBitsOffset. header2 := classPointer. - header3 := 0. sizeHiBits := (classFormat bitAnd: 16r60000) >> 9. cClass := header1 bitAnd: CompactClassMask. "compact class field from format word" byteSize := (classFormat bitAnd: SizeMask + Size4Bit) + sizeHiBits. "size in bytes -- low 2 bits are 0" "Note this byteSize comes from the format word of the class which is pre-shifted to 4 bytes per field. Need another shift for 8 bytes per word..." byteSize := byteSize << (ShiftForWord-2). format := self formatOfHeader: classFormat. self flag: #sizeLowBits. format < 8 ifTrue: [format = 6 ifTrue: ["long32 bitmaps" bm1 := BytesPerWord-1. byteSize := byteSize + (size * 4) + bm1 bitAnd: LongSizeMask. "round up" binc := bm1 - ((size * 4) + bm1 bitAnd: bm1). "odd bytes" "extra low bit (4) for 64-bit VM goes in 4-bit (betw hdr bits and sizeBits)" header1 := header1 bitOr: (binc bitAnd: 4)] ifFalse: [byteSize := byteSize + (size * BytesPerWord) "Arrays and 64-bit bitmaps"]] ifFalse: ["Strings and Methods" bm1 := BytesPerWord-1. byteSize := byteSize + size + bm1 bitAnd: LongSizeMask. "round up" binc := bm1 - (size + bm1 bitAnd: bm1). "odd bytes" "low bits of byte size go in format field" header1 := header1 bitOr: (binc bitAnd: 3) << 8. "extra low bit (4) for 64-bit VM goes in 4-bit (betw hdr bits and sizeBits)" header1 := header1 bitOr: (binc bitAnd: 4)]. + byteSize > 255 "requires size header word/full header" + ifTrue: [header3 := byteSize. hdrSize := 3] + ifFalse: [header1 := header1 bitOr: byteSize. hdrSize := cClass = 0 ifTrue: [2] ifFalse: [1]]. + ^self allocate: byteSize headerSize: hdrSize h1: header1 h2: header2 h3: header3 doFill: true format: format! - byteSize > 255 - ifTrue: ["requires size header word" - header3 := byteSize. - header1 := header1] - ifFalse: [header1 := header1 bitOr: byteSize]. - - hdrSize := header3 > 0 - ifTrue: [3 "requires full header"] - ifFalse: [cClass = 0 ifTrue: [2] ifFalse: [1]]. - newObj := self allocate: byteSize headerSize: hdrSize h1: header1 h2: header2 h3: header3 doFill: true format: format. - ^ newObj! Item was changed: ----- Method: ObjectMemory>>startOfMemory (in category 'object enumeration') ----- startOfMemory + "Return the start of object memory. Use a macro so as not to punish the debug VM." + <cmacro: '() memory'> - "Return the start of object memory." <returnTypeC: #usqInt> ^memory! Item was changed: ----- Method: StackInterpreter>>findClassOfMethod:forReceiver: (in category 'debug support') ----- findClassOfMethod: meth forReceiver: rcvr + | rclass currClass classDict classDictSize methodArray i | + (self addressCouldBeObj: meth) ifFalse: + [^objectMemory nilObject]. + (self addressCouldBeOop: rcvr) + ifTrue: [rclass := objectMemory fetchClassOf: rcvr] + ifFalse: [rclass := self methodClassOf: meth]. + currClass := rclass. - | currClass classDict classDictSize methodArray i | - currClass := objectMemory fetchClassOf: rcvr. [classDict := objectMemory fetchPointer: MethodDictionaryIndex ofObject: currClass. classDictSize := objectMemory fetchWordLengthOf: classDict. methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: classDict. i := 0. [i < (classDictSize - SelectorStart)] whileTrue: [meth = (objectMemory fetchPointer: i ofObject: methodArray) ifTrue: [^currClass]. i := i + 1]. currClass := self superclassOf: currClass. currClass = objectMemory nilObject] whileFalse. + ^rclass "method not found in superclass chain"! - ^objectMemory fetchClassOf: rcvr "method not found in superclass chain"! Item was changed: ----- Method: StackInterpreter>>findSelectorOfMethod:forReceiver: (in category 'debug support') ----- findSelectorOfMethod: meth forReceiver: rcvr | currClass classDict classDictSize methodArray i | + (self addressCouldBeObj: meth) ifFalse: + [^objectMemory nilObject]. + (self addressCouldBeOop: rcvr) + ifTrue: [currClass := objectMemory fetchClassOf: rcvr] + ifFalse: [currClass := self methodClassOf: meth]. - currClass := objectMemory fetchClassOf: rcvr. [classDict := objectMemory fetchPointer: MethodDictionaryIndex ofObject: currClass. classDictSize := objectMemory fetchWordLengthOf: classDict. methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: classDict. i := 0. [i <= (classDictSize - SelectorStart)] whileTrue: [meth = (objectMemory fetchPointer: i ofObject: methodArray) ifTrue: [^(objectMemory fetchPointer: i + SelectorStart ofObject: classDict)]. i := i + 1]. currClass := self superclassOf: currClass. currClass = objectMemory nilObject] whileFalse. ^currClass "method not found in superclass chain"! Item was changed: ----- Method: StackInterpreter>>noInlineTemporary:in:put: (in category 'internal interpreter access') ----- noInlineTemporary: offset in: theFP put: valueOop <var: #theFP type: #'char *'> <inline: false> + ^self temporary: offset in: theFP put: valueOop! - self temporary: offset in: theFP put: valueOop! Item was changed: ----- Method: StackInterpreter>>printStackPage: (in category 'debug printing') ----- printStackPage: page <inline: false> <var: #page type: #'StackPage *'> self print: 'page '; printHexPtr: (self cCode: [page] inSmalltalk: [page baseAddress]); print: ' ('; printNum: (stackPages pageIndexFor: page realStackLimit); print: ') (trace: '; printNum: page trace; printChar: $). (stackPages isFree: page) ifTrue: [self print: ' (free)']. page = stackPages mostRecentlyUsedPage ifTrue: [self print: ' (MRU)']. + self cr; tab; print: 'ba: '; + printHexPtr: page baseAddress; print: ' - sl: '; + printHexPtr: page realStackLimit; print: ' - sl-so: '; + printHexPtr: page realStackLimit - self stackLimitOffset; print: ' - la:'; - self cr; tab; - printHexPtr: page baseAddress; print: ' - '; - printHexPtr: page realStackLimit; print: ' - '; printHexPtr: page lastAddress. (stackPages isFree: page) ifFalse: [self cr; tab; print: 'baseFP '; printHexPtr: page baseFP. self "cr;" tab; print: 'headFP '; printHexPtr: page headFP. self "cr;" tab; print: 'headSP '; printHexPtr: page headSP]. self cr; tab; print: 'prev '; printHexPtr: (self cCode: 'page->prevPage' inSmalltalk: [page prevPage baseAddress]); print: ' ('; printNum: (stackPages pageIndexFor: page prevPage realStackLimit); printChar: $). self tab; print: 'next '; printHexPtr: (self cCode: 'page->nextPage' inSmalltalk: [page nextPage baseAddress]); print: ' ('; printNum: (stackPages pageIndexFor: page nextPage realStackLimit); printChar: $). self cr! Item was changed: ----- Method: StackInterpreter>>temporary:in:put: (in category 'internal interpreter access') ----- temporary: offset in: theFP put: valueOop "See StackInterpreter class>>initializeFrameIndices" | frameNumArgs | <inline: true> <var: #theFP type: #'char *'> + ^offset < (frameNumArgs := self frameNumArgs: theFP) - offset < (frameNumArgs := self frameNumArgs: theFP) ifTrue: [stackPages longAt: theFP + FoxCallerSavedIP + ((frameNumArgs - offset) * BytesPerWord) put: valueOop] ifFalse: [stackPages longAt: theFP + FoxReceiver - BytesPerWord + ((frameNumArgs - offset) * BytesPerWord) put: valueOop]! Item was changed: Object subclass: #TMethod + instanceVariableNames: 'selector returnType args locals declarations primitive parseTree labels writtenToGlobalVarsCache complete export static sharedLabel sharedCase comment definingClass globalStructureBuildMethodHasFoo canAsmLabel mustAsmLabel properties cascadeVariableNumber' - instanceVariableNames: 'selector returnType args locals declarations primitive parseTree labels writtenToGlobalVarsCache complete export static sharedLabel sharedCase comment definingClass globalStructureBuildMethodHasFoo canAsmLabel mustAsmLabel properties typedByPropagation cascadeVariableNumber' classVariableNames: 'CaseStatements' poolDictionaries: '' category: 'VMMaker-Translation to C'! Item was removed: - ----- Method: TMethod>>noteTypedByPropagation: (in category 'inlining') ----- - noteTypedByPropagation: aVariableName - typedByPropagation ifNil: - [typedByPropagation := Set new]. - typedByPropagation add: aVariableName! Item was changed: ----- Method: TMethod>>postCopy (in category 'copying') ----- postCopy args := args copy. locals := locals copy. declarations := declarations copy. parseTree := parseTree copy. + labels := labels copy! - labels := labels copy. - typedByPropagation := typedByPropagation copy! Item was removed: - ----- Method: TMethod>>wasTypedByPropagation: (in category 'inlining') ----- - wasTypedByPropagation: aVariableName - ^typedByPropagation notNil - and: [typedByPropagation includes: aVariableName]! Item was changed: ----- Method: VMClass class>>translationClass (in category 'translation') ----- translationClass + "Return the class to use as the interpreterCLass when translating. For the all-in-one - "Return te class to use as the interpreterCLass when translating. For the all-in-one VMs that inherit from ObjectMemory this is the receiver. But for the separate VMs where most primitives are in a subclass it will be the subclass with the primitives." ^self!

1 0

VM Maker: VMMaker.oscog-eem.228.mcz
by commits＠source.squeak.org 11 Dec '12

11 Dec '12

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.228.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.228 Author: eem Time: 11 December 2012, 1:56:43.108 pm UUID: d0ee0b3a-efb3-4092-a37d-b6dfd1036b49 Ancestors: VMMaker.oscog-eem.227 Change generation of plugin code so that internal plugins call VM routines directly and external plugins call through their own local copies of the function pointers in InterpreterProxy. External plugins copy the InterpreterProxy functions to their local copies in setInterpreter:. Fix a couple of prims in BalloonEnginePlugin that had variables called isArray which now clash with the funciton of the same name. Add the ImmX11Plugin. Change implementations of stObject:at:put: to return their value, to match the declaration in InterpreterProxy. Delete some obsolete code in SmartSyntaxPluginCodeGenerator (emitLoad:asBooleanValueFrom:on: et al). Add a class to test consistency between *Interpreter(Primitives) implementations and InterpreterProxy implementations. These differ because void result functions are still declared as sqInt result functions in InterprerterProxy/struct VirtualMachine. =============== Diff against VMMaker.oscog-eem.227 =============== Item was changed: ----- Method: BalloonEnginePlugin>>primitiveAddBezierShape (in category 'primitives') ----- primitiveAddBezierShape + | failureCode points lineFill lineWidth fillIndex length pointsIsArray segSize nSegments | - | failureCode points lineFill lineWidth fillIndex length isArray segSize nSegments | <export: true> <inline: false> "Fail if we have the wrong number of arguments" interpreterProxy methodArgumentCount = 5 ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs]. lineFill := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 0). lineWidth := interpreterProxy stackIntegerValue: 1. fillIndex := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 2). nSegments := interpreterProxy stackIntegerValue: 3. points := interpreterProxy stackObjectValue: 4. interpreterProxy failed ifTrue:[^interpreterProxy primitiveFailFor: PrimErrBadArgument]. (failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 5) requiredState: GEStateUnlocked) = 0 ifFalse:[^interpreterProxy primitiveFailFor: failureCode]. "First, do a check if the points look okay" length := interpreterProxy slotSizeOf: points. (interpreterProxy isWords: points) ifTrue:[ + pointsIsArray := false. - isArray := false. "Either PointArray or ShortPointArray" (length = (nSegments * 3) or:[length = (nSegments * 6)]) ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadArgument]. ] ifFalse:["Must be Array of points" (interpreterProxy isArray: points) ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadArgument]. length = (nSegments * 3) ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadArgument]. + pointsIsArray := true. - isArray := true. ]. "Now check that we have some hope to have enough free space. Do this by assuming nPoints boundaries of maximum size, hoping that most of the fills will be colors and many boundaries will be line segments" (lineWidth = 0 or:[lineFill = 0]) ifTrue:[segSize := GLBaseSize] ifFalse:[segSize := GLWideSize]. (self needAvailableSpace: segSize * nSegments) ifFalse:[^interpreterProxy primitiveFailFor: GEFWorkTooBig]. "Check the fills" ((self isFillOkay: lineFill) and:[self isFillOkay: fillIndex]) ifFalse:[^interpreterProxy primitiveFailFor: GEFWrongFill]. "Transform colors" lineFill := self transformColor: lineFill. fillIndex := self transformColor: fillIndex. engineStopped ifTrue:[^interpreterProxy primitiveFailFor: GEFEngineStopped]. "Check if have anything at all to do" ((lineFill = 0 or:[lineWidth = 0]) and:[fillIndex = 0]) ifTrue:[^interpreterProxy pop: 5]. "Transform the lineWidth" lineWidth = 0 ifFalse:[ lineWidth := self transformWidth: lineWidth. lineWidth < 1 ifTrue:[lineWidth := 1]]. "And load the actual shape" + pointsIsArray ifTrue:[ - isArray ifTrue:[ self loadArrayShape: points nSegments: nSegments fill: fillIndex lineWidth: lineWidth lineFill: lineFill. ] ifFalse:[ self loadShape: (interpreterProxy firstIndexableField: points) nSegments: nSegments fill: fillIndex lineWidth: lineWidth lineFill: lineFill pointsShort: (nSegments * 3 = length)]. engineStopped ifTrue:[^interpreterProxy primitiveFailFor: GEFEngineStopped]. interpreterProxy failed ifTrue:[^interpreterProxy primitiveFailFor: GEFEntityLoadFailed]. self needsFlushPut: 1. self storeEngineStateInto: engine. interpreterProxy pop: 5. "Leave rcvr on stack"! Item was changed: ----- Method: BalloonEnginePlugin>>primitiveAddPolygon (in category 'primitives') ----- primitiveAddPolygon + | failureCode points lineFill lineWidth fillIndex nPoints length pointsIsArray segSize | - | failureCode points lineFill lineWidth fillIndex nPoints length isArray segSize | <export: true> <inline: false> "Fail if we have the wrong number of arguments" interpreterProxy methodArgumentCount = 5 ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs]. lineFill := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 0). lineWidth := interpreterProxy stackIntegerValue: 1. fillIndex := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 2). nPoints := interpreterProxy stackIntegerValue: 3. points := interpreterProxy stackObjectValue: 4. interpreterProxy failed ifTrue:[^interpreterProxy primitiveFailFor: PrimErrBadArgument]. (failureCode := self quickLoadEngineFrom: (interpreterProxy stackValue: 5) requiredState: GEStateUnlocked) = 0 ifFalse:[^interpreterProxy primitiveFailFor: failureCode]. "First, do a check if the points look okay" length := interpreterProxy slotSizeOf: points. (interpreterProxy isWords: points) ifTrue:[ + pointsIsArray := false. - isArray := false. "Either PointArray or ShortPointArray" (length = nPoints or:[nPoints * 2 = length]) ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadArgument]. ] ifFalse:["Must be Array of points" (interpreterProxy isArray: points) ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadArgument]. length = nPoints ifFalse:[^interpreterProxy primitiveFailFor: PrimErrBadArgument]. + pointsIsArray := true. - isArray := true. ]. "Now check that we have some hope to have enough free space. Do this by assuming nPoints boundaries of maximum size, hoping that most of the fills will be colors and many boundaries will be line segments" (lineWidth = 0 or:[lineFill = 0]) ifTrue:[segSize := GLBaseSize] ifFalse:[segSize := GLWideSize]. (self needAvailableSpace: segSize * nPoints) ifFalse:[^interpreterProxy primitiveFail]. "Check the fills" ((self isFillOkay: lineFill) and:[self isFillOkay: fillIndex]) ifFalse:[^interpreterProxy primitiveFailFor: GEFWrongFill]. "Transform colors" lineFill := self transformColor: lineFill. fillIndex := self transformColor: fillIndex. engineStopped ifTrue:[^interpreterProxy primitiveFailFor: GEFEngineStopped]. "Check if have anything at all to do" ((lineFill = 0 or:[lineWidth = 0]) and:[fillIndex = 0]) ifTrue:[^interpreterProxy pop: 5]. "Transform the lineWidth" lineWidth = 0 ifFalse:[lineWidth := self transformWidth: lineWidth]. "And load the actual polygon" + pointsIsArray ifTrue:[ - isArray ifTrue:[ self loadArrayPolygon: points nPoints: nPoints fill: fillIndex lineWidth: lineWidth lineFill: lineFill ] ifFalse:[ self loadPolygon: (interpreterProxy firstIndexableField: points) nPoints: nPoints fill: fillIndex lineWidth: lineWidth lineFill: lineFill pointsShort: (nPoints = length)]. engineStopped ifTrue:[^interpreterProxy primitiveFailFor: GEFEngineStopped]. interpreterProxy failed ifTrue: [^interpreterProxy primitiveFailFor: GEFEntityLoadFailed]. self needsFlushPut: 1. self storeEngineStateInto: engine. interpreterProxy pop: 5. "Leave rcvr on stack"! Item was changed: ----- Method: CCodeGenerator>>emitCVariablesOn: (in category 'C code generator') ----- emitCVariablesOn: aStream "Store the global variable declarations on the given stream." aStream cr; nextPutAll: '/*** Variables ***/'; cr. (self sortStrings: variables) do: [:var | | varString decl | varString := var asString. decl := variableDeclarations at: varString ifAbsent: ['sqInt ' , varString]. decl first == $# "support cgen var: #bytecodeSetSelector declareC: '#define bytecodeSetSelector 0' hack" ifTrue: [aStream nextPutAll: decl; cr] ifFalse: [self isGeneratingPluginCode ifTrue: [varString = 'interpreterProxy' + ifTrue: "quite special..." + [self preDeclareInterpreterProxyOn: aStream] - ifTrue: ["quite special..." - aStream cr; nextPutAll: '#ifdef SQUEAK_BUILTIN_PLUGIN'. - aStream cr; nextPutAll: 'extern'. - aStream cr; nextPutAll: '#endif'; cr] ifFalse: [(decl beginsWith: 'static') ifFalse: [aStream nextPutAll: 'static ']]] ifFalse: [(vmClass mustBeGlobal: varString) ifFalse: [(decl beginsWith: 'static') ifFalse: [aStream nextPutAll: 'static ']]]. aStream nextPutAll: decl; nextPut: $;; cr]]. aStream cr! Item was added: + ----- Method: CCodeGenerator>>preDeclareInterpreterProxyOn: (in category 'C code generator') ----- + preDeclareInterpreterProxyOn: aStream + "Put the necessary #defines needed before interpreterProxy. Basically + internal plugins use the VM's interpreterProxy variable and external plugins use + their own. In addition the VMPluginCodeGenerator can choose to keep local copies + all functions." + aStream cr; nextPutAll: '#ifdef SQUEAK_BUILTIN_PLUGIN'. + aStream cr; nextPutAll: 'extern'. + aStream cr; nextPutAll: '#endif'; cr! Item was changed: ----- Method: CCodeGeneratorGlobalStructure>>emitCVariablesOn: (in category 'C code generator') ----- emitCVariablesOn: aStream "Store the global variable declarations on the given stream. Break logic into vars for structure and vars for non-structure." | structure nonstruct | structure := WriteStream on: (String new: 32768). nonstruct := WriteStream on: (String new: 32768). aStream nextPutAll: '/*** Variables ***/'; cr. structure nextPutAll: '#if SQ_USE_GLOBAL_STRUCT'; cr; nextPutAll: '# define _iss /* define in-struct static as void */'; cr; nextPutAll: 'static struct foo {'; cr; nextPutAll: '#else'; cr; nextPutAll: '# define _iss static'; cr; nextPutAll: '#endif'; cr. self buildSortedVariablesCollection do: [ :var | | decl varString inStruct target | target := (inStruct := self placeInStructure: (varString := var asString)) ifTrue: [structure] ifFalse: [nonstruct]. decl := variableDeclarations at: varString ifAbsent: ['sqInt ' , varString]. decl first == $# "support cgen var: #bytecodeSetSelector declareC: '#define bytecodeSetSelector 0' hack" ifTrue: [target nextPutAll: decl; cr] ifFalse: [self isGeneratingPluginCode ifTrue: [varString = 'interpreterProxy' + ifTrue: "quite special..." + [self preDeclareInterpreterProxyOn: target] - ifTrue: ["quite special..." - target cr; nextPutAll: '#ifdef SQUEAK_BUILTIN_PLUGIN'. - target cr; nextPutAll: 'extern'. - target cr; nextPutAll: '#endif'; cr] ifFalse: [target nextPutAll: 'static ']] ifFalse: [(vmClass mustBeGlobal: varString) ifFalse: [target nextPutAll: (inStruct ifTrue: ['_iss '] ifFalse: ['static '])]]. target nextPutAll: decl; nextPut: $;; cr]]. structure nextPutAll: '#undef _iss'; cr; nextPutAll: '#if SQ_USE_GLOBAL_STRUCT'; cr; nextPutAll: ' } fum;'; cr; nextPutAll: '# define DECL_MAYBE_SQ_GLOBAL_STRUCT register struct foo * foo = &fum;'; cr; nextPutAll: '# define DECL_MAYBE_VOLATILE_SQ_GLOBAL_STRUCT volatile register struct foo * foo = &fum;'; cr; nextPutAll: '# define GIV(interpreterInstVar) (foo->interpreterInstVar)'; cr; nextPutAll: '#else'; cr; nextPutAll: '# define DECL_MAYBE_SQ_GLOBAL_STRUCT /* oh, no mr bill!! */'; cr; nextPutAll: '# define DECL_MAYBE_VOLATILE_SQ_GLOBAL_STRUCT /* oh no, mr bill!! */'; cr; nextPutAll: '# define GIV(interpreterInstVar) interpreterInstVar'; cr; nextPutAll: '#endif'; cr. "if the machine needs the fum structure defining locally, do it now" localStructDef ifTrue: [structure nextPutAll: '#if SQ_USE_GLOBAL_STRUCT'; cr; nextPutAll: 'static struct foo * foo = &fum;'; cr; nextPutAll: '#endif'; cr]. aStream nextPutAll: structure contents; nextPutAll: nonstruct contents; cr! Item was changed: ----- Method: IA32ABIPlugin>>primCallOutDoubleReturn (in category 'primitives-callouts') ----- primCallOutDoubleReturn "Call a foreign function that answers a double-precision floating-point result in %f0 according to IA32-ish ABI rules. The primitive will have a signature of the form functionAddress <Alien> primFFICallResult: result <Alien|Object> with: firstArg <Alien | Integer> ... with: lastArg <Alien | Integer> ^<Alien> <primitive: 'primCallOutDoubleReturn' error: errorCode module: 'IA32ABI'>. Answer result. If result is an Alien the value answered by the call will be assigned to result." | errCode mac result | <export: true> mac := interpreterProxy methodArgumentCount. self cppIf: STACKVM ifTrue: "In the STACKVM stacks grow down" + [errCode := self call: interpreterProxy getStackPointer + mac - 2 "ptr to 0th arg" + IA32: 1 - mac "nargs negated to imply stack direction" + Double: mac "funcOffset" + Return: mac - 1 "resultOffset"] - [self cCode: 'errCode = callIA32DoubleReturn(interpreterProxy->getStackPointer() + mac - 2, /* arg vec */ - 1 - mac /* nargs */, - mac /* funcOffset*/, - mac - 1 /* resultOffset */)' - inSmalltalk: [errCode := PrimErrUnsupported]] ifFalse: + [errCode := self call: interpreterProxy getStackPointer - mac + 2 "ptr to 0th arg" + IA32: mac - 1 "nargs" + Double: mac "funcOffset" + Return: mac - 1 "resultOffset"]. - [self cCode: 'errCode = callIA32DoubleReturn(interpreterProxy->getStackPointer() - mac + 2, /* arg vec */ - mac - 1 /* nargs */, - mac /* funcOffset*/, - mac - 1 /* resultOffset */)' - inSmalltalk: [errCode := PrimErrUnsupported]]. errCode ~= 0 ifTrue: [^interpreterProxy primitiveFailFor: errCode]. result := interpreterProxy stackValue: mac - 1. interpreterProxy pop: mac + 1 thenPush: result! Item was changed: ----- Method: IA32ABIPlugin>>primCallOutFloatReturn (in category 'primitives-callouts') ----- primCallOutFloatReturn "Call a foreign function that answers a single-precision floating-point result in %f0 according to IA32-ish ABI rules. The primitive will have a signature of the form functionAddress <Alien> primFFICallResult: result <Alien|Object> with: firstArg <Alien | Integer> ... with: lastArg <Alien | Integer> ^<Alien> <primitive: 'primCallOutFloatReturn' error: errorCode module: 'IA32ABI'>. Answer result. If result is an Alien the value answered by the call will be assigned to result." | errCode mac result | <export: true> mac := interpreterProxy methodArgumentCount. self cppIf: STACKVM ifTrue: "In the STACKVM stacks grow down" + [errCode := self call: interpreterProxy getStackPointer + mac - 2 "ptr to 0th arg" + IA32: 1 - mac "nargs negated to imply stack direction" + Float: mac "funcOffset" + Return: mac - 1 "resultOffset"] - [self cCode: 'errCode = callIA32FloatReturn(interpreterProxy->getStackPointer() + mac - 2, /* arg vec */ - 1 - mac /* nargs */, - mac /* funcOffset*/, - mac - 1 /* resultOffset */)' - inSmalltalk: [errCode := PrimErrUnsupported]] ifFalse: + [errCode := self call: interpreterProxy getStackPointer - mac + 2 "ptr to 0th arg" + IA32: mac - 1 "nargs" + Float: mac "funcOffset" + Return: mac - 1 "resultOffset"]. - [self cCode: 'errCode = callIA32FloatReturn(interpreterProxy->getStackPointer() - mac + 2, /* arg vec */ - mac - 1 /* nargs */, - mac /* funcOffset*/, - mac - 1 /* resultOffset */)' - inSmalltalk: [errCode := PrimErrUnsupported]]. errCode ~= 0 ifTrue: [^interpreterProxy primitiveFailFor: errCode]. result := interpreterProxy stackValue: mac - 1. interpreterProxy pop: mac + 1 thenPush: result! Item was changed: ----- Method: IA32ABIPlugin>>primCallOutIntegralReturn (in category 'primitives-callouts') ----- primCallOutIntegralReturn "Call a foreign function that answers an integral result in %eax (and possibly %edx) according to IA32-ish ABI rules. The primitive will have a signature of the form functionAddress <Alien> primFFICallResult: result <Alien|Object> with: firstArg <Alien | Integer> ... with: lastArg <Alien | Integer> ^<Alien> <primitive: 'primCallOutIntegralReturn' error: errorCode module: 'IA32ABI'>. Answer result. If result is an Alien the value answered by the call will be assigned to result." | errCode mac result | <export: true> mac := interpreterProxy methodArgumentCount. self cppIf: STACKVM ifTrue: "In the STACKVM stacks grow down" + [errCode := self call: interpreterProxy getStackPointer + mac - 2 "ptr to 0th arg" + IA32: 1 - mac "nargs negated to imply stack direction" + Integral: mac "funcOffset" + Return: mac - 1 "resultOffset"] - [self cCode: 'errCode = callIA32IntegralReturn(interpreterProxy->getStackPointer() + mac - 2, /* arg vec */ - 1 - mac /* nargs */, - mac /* funcOffset*/, - mac - 1 /* resultOffset */)' - inSmalltalk: [errCode := PrimErrUnsupported]] ifFalse: + [errCode := self call: interpreterProxy getStackPointer - mac + 2 "ptr to 0th arg" + IA32: mac - 1 "nargs" + Integral: mac "funcOffset" + Return: mac - 1 "resultOffset"]. - [self cCode: 'errCode = callIA32IntegralReturn(interpreterProxy->getStackPointer() - mac + 2, /* arg vec */ - mac - 1 /* nargs */, - mac /* funcOffset*/, - mac - 1 /* resultOffset */)' - inSmalltalk: [errCode := PrimErrUnsupported]]. errCode ~= 0 ifTrue: [^interpreterProxy primitiveFailFor: errCode]. result := interpreterProxy stackValue: mac - 1. interpreterProxy pop: mac + 1 thenPush: result! Item was changed: ----- Method: IA32ABIPlugin>>primVarArgsCallOutDoubleReturn (in category 'primitives-callouts') ----- primVarArgsCallOutDoubleReturn "Call a foreign function that answers a double-precision floating-point result in %f0 according to IA32-ish ABI rules. The primitive will have a signature of the form functionAddress <Alien> primFFICallResult: result <Alien|Object> withArguments: args <Array of: Alien | Integer> ^<Alien> <primitive: 'primVarArgsCallOutDoubleReturn' error: errorCode module: 'IA32ABI'>. Answer result. If result is an Alien the value answered by the call will be assigned to result." | array mac errCode result | <export: true> array := interpreterProxy stackValue: 0. (interpreterProxy isArray: array) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. mac := interpreterProxy methodArgumentCount. + errCode := self call: (interpreterProxy firstIndexableField: array) "ptr to 0th arg" + IA32: (interpreterProxy stSizeOf: array) "nargs" + Double: 2 "func stackValue" + Return: 1. "result stackValue" - self cCode: 'errCode = callIA32DoubleReturn(interpreterProxy->firstIndexableField(array), /* arg vec */ - interpreterProxy->stSizeOf(array) /* nargs */, - 2 /* funcOffset*/, - 1 /* resultOffset */)' - inSmalltalk: [errCode := PrimErrUnsupported]. errCode ~= 0 ifTrue: [^interpreterProxy primitiveFailFor: errCode]. result := interpreterProxy stackValue: 1. interpreterProxy pop: mac + 1 thenPush: result! Item was changed: ----- Method: IA32ABIPlugin>>primVarArgsCallOutFloatReturn (in category 'primitives-callouts') ----- primVarArgsCallOutFloatReturn "Call a foreign function that answers a single-precision floating-point result in %f0 according to IA32-ish ABI rules. The primitive will have a signature of the form functionAddress <Alien> primFFICallResult: result <Alien|Object> withArguments: args <Array of: Alien | Integer> ^<Alien> <primitive: 'primVarArgsCallOutFloatReturn' error: errorCode module: 'IA32ABI'>. Answer result. If result is an Alien the value answered by the call will be assigned to result." | array mac errCode result | <export: true> array := interpreterProxy stackValue: 0. (interpreterProxy isArray: array) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. mac := interpreterProxy methodArgumentCount. + errCode := self call: (interpreterProxy firstIndexableField: array) "ptr to 0th arg" + IA32: (interpreterProxy stSizeOf: array) "nargs" + Float: 2 "func stackValue" + Return: 1. "result stackValue" - self cCode: 'errCode = callIA32FloatReturn(interpreterProxy->firstIndexableField(array), /* arg vec */ - interpreterProxy->stSizeOf(array) /* nargs */, - 2 /* funcOffset*/, - 1 /* resultOffset */)' - inSmalltalk: [errCode := PrimErrUnsupported]. errCode ~= 0 ifTrue: [^interpreterProxy primitiveFailFor: errCode]. result := interpreterProxy stackValue: 1. interpreterProxy pop: mac + 1 thenPush: result! Item was changed: ----- Method: IA32ABIPlugin>>primVarArgsCallOutIntegralReturn (in category 'primitives-callouts') ----- primVarArgsCallOutIntegralReturn "Call a foreign function that answers an integral result in %eax (and possibly %edx) according to IA32-ish ABI rules. The primitive will have a signature of the form functionAddress <Alien> primFFICallResult: result <Alien|Object> withArguments: args <Array of: Alien | Integer> ^<Alien> <primitive: 'primVarArgsCallOutIntegralReturn' error: errorCode module: 'IA32ABI'>. Answer result. If result is an Alien the value answered by the call will be assigned to result." | array mac errCode result | <export: true> array := interpreterProxy stackValue: 0. (interpreterProxy isArray: array) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. mac := interpreterProxy methodArgumentCount. + errCode := self call: (interpreterProxy firstIndexableField: array) "ptr to 0th arg" + IA32: (interpreterProxy stSizeOf: array) "nargs" + Integral: 2 "func stackValue" + Return: 1. "result stackValue" - self cCode: 'errCode = callIA32IntegralReturn(interpreterProxy->firstIndexableField(array), /* arg vec */ - interpreterProxy->stSizeOf(array) /* nargs */, - 2 /* funcOffset*/, - 1 /* resultOffset */)' - inSmalltalk: [errCode := PrimErrUnsupported]. errCode ~= 0 ifTrue: [^interpreterProxy primitiveFailFor: errCode]. result := interpreterProxy stackValue: 1. interpreterProxy pop: mac + 1 thenPush: result! Item was changed: ----- Method: IA32ABIPlugin>>setInterpreter: (in category 'initialize') ----- setInterpreter: anInterpreter "Note: This is coded so that is can be run from Squeak." | ok | <export: true> <var: #anInterpreter type: #'struct VirtualMachine*'> interpreterProxy := anInterpreter. ok := interpreterProxy majorVersion = 1 and: [interpreterProxy minorVersion >= 12]. + ok ifTrue: + [self expandDereferenceInterpreterProxyFunctionTable]. ^ok! Item was added: + SmartSyntaxInterpreterPlugin subclass: #ImmX11Plugin + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'VMMaker-Plugins'! Item was added: + ----- Method: ImmX11Plugin class>>declareHeaderFilesIn: (in category 'as yet unclassified') ----- + declareHeaderFilesIn: cg + + cg addHeaderFile: '<locale.h>'. + cg addHeaderFile: '"sqUnixMain.h"'. + cg addHeaderFile: '"sqUnixCharConv.h"', Character cr asString, + 'extern char *setLocale(char *, size_t);', Character cr asString, + 'extern int setCompositionWindowPosition(int, int);', Character cr asString, + 'extern int setCompostionFocus(int);'.! Item was added: + ----- Method: ImmX11Plugin>>initialiseModule (in category 'initialize-release') ----- + initialiseModule + + <export: true> + ^ true + ! Item was added: + ----- Method: ImmX11Plugin>>primGetEncoding (in category 'primitives') ----- + primGetEncoding + + | ret array len | + + <export: true> + <var: #len type: 'int'> + <var: #array type: 'char *'> + len := self cCode: 'strlen(sqTextEncoding)'. + + ret := interpreterProxy + instantiateClass: interpreterProxy classString + indexableSize: len. + array := self cCoerce: (interpreterProxy firstIndexableField: ret) to: 'char *'. + self cCode: 'strncpy(array, (char *)sqTextEncoding, len)'. + + ^ ret.! Item was added: + ----- Method: ImmX11Plugin>>primGetLocale (in category 'primitives') ----- + primGetLocale + + | ret array len locale | + + <export: true> + <var: #len type: 'int'> + <var: #array type: 'char *'> + <var: #locale type: 'char *'> + + locale := self cCode: 'setlocale(LC_CTYPE, "")'. + (self cCode: 'locale') + ifFalse: [ ret := interpreterProxy nilObject ] + ifTrue: [ + len := self cCode: 'strlen(locale)'. + ret := interpreterProxy + instantiateClass: interpreterProxy classString + indexableSize: len. + array := self cCoerce: (interpreterProxy firstIndexableField: ret) to: 'char *'. + self cCode: 'strncpy(array, (char *)locale, len)'. + ]. + ^ ret.! Item was added: + ----- Method: ImmX11Plugin>>primGetLocaleEncoding (in category 'primitives') ----- + primGetLocaleEncoding + + | ret array len | + + <export: true> + <var: #len type: 'int'> + <var: #array type: 'char *'> + + (self cCode: '(int) localeEncoding') + ifFalse: [ ret := interpreterProxy nilObject ] + ifTrue: [ + len := self cCode: 'strlen(localeEncoding)'. + ret := interpreterProxy + instantiateClass: interpreterProxy classString + indexableSize: len. + array := self cCoerce: (interpreterProxy firstIndexableField: ret) to: 'char *'. + self cCode: 'strncpy(array, (char *)localeEncoding, len)'. + ]. + ^ ret.! Item was added: + ----- Method: ImmX11Plugin>>primGetPathEnc (in category 'primitives') ----- + primGetPathEnc + + | ret array len | + + <export: true> + <var: #len type: 'int'> + <var: #array type: 'char *'> + len := self cCode: 'strlen(uxPathEncoding)'. + + ret := interpreterProxy + instantiateClass: interpreterProxy classString + indexableSize: len. + array := self cCoerce: (interpreterProxy firstIndexableField: ret) to: 'char *'. + self cCode: 'strncpy(array, (char *)uxPathEncoding, len)'. + + ^ ret.! Item was added: + ----- Method: ImmX11Plugin>>primGetTextEnc (in category 'primitives') ----- + primGetTextEnc + + | ret array len | + + <export: true> + <var: #len type: 'int'> + <var: #array type: 'char *'> + len := self cCode: 'strlen(uxTextEncoding)'. + + ret := interpreterProxy + instantiateClass: interpreterProxy classString + indexableSize: len. + array := self cCoerce: (interpreterProxy firstIndexableField: ret) to: 'char *'. + self cCode: 'strncpy(array, (char *)uxTextEncoding, len)'. + + ^ ret.! Item was added: + ----- Method: ImmX11Plugin>>primGetXWinEnc (in category 'primitives') ----- + primGetXWinEnc + + | ret array len | + + <export: true> + <var: #len type: 'int'> + <var: #array type: 'char *'> + len := self cCode: 'strlen(uxXWinEncoding)'. + + ret := interpreterProxy + instantiateClass: interpreterProxy classString + indexableSize: len. + array := self cCoerce: (interpreterProxy firstIndexableField: ret) to: 'char *'. + self cCode: 'strncpy(array, (char *)uxXWinEncoding, len)'. + + ^ ret.! Item was added: + ----- Method: ImmX11Plugin>>primIsTextEncUTF8 (in category 'primitives') ----- + primIsTextEncUTF8 + + <export: true> + self primitive: 'primIsTextEncUTF8'. + ^ (self cCode: 'textEncodingUTF8') asOop: Boolean.! Item was added: + ----- Method: ImmX11Plugin>>primSetCompositionFocus: (in category 'primitives') ----- + primSetCompositionFocus: bool + + | ret | + <export: true> + self primitive: 'primSetCompositionFocus' + parameters: #(Boolean). + + ret := self cCode: 'setCompositionFocus(bool)'. + + ret = false ifTrue: [ + interpreterProxy primitiveFail. + ^ nil + ]. + + ^ ret asOop: Boolean + ! Item was added: + ----- Method: ImmX11Plugin>>primSetCompositionWindowPositionX:y: (in category 'primitives') ----- + primSetCompositionWindowPositionX: x y: y + + | ret | + + <export: true> + self primitive: 'primSetCompositionWindowPosition' + parameters: #(SmallInteger SmallInteger). + + + ret := self cCode: 'setCompositionWindowPosition(x, y)'. + + ret = false ifTrue: [ + interpreterProxy primitiveFail. + ^ nil + ]. + + ^ ret asOop: Boolean + + ! Item was added: + ----- Method: ImmX11Plugin>>primSetEncoding: (in category 'primitives') ----- + primSetEncoding: encoding + + | name len | + <export: true> + <var: #name type: 'char *'> + <var: #len type: 'size_t'> + len := interpreterProxy stSizeOf: encoding. + name := self cCoerce: (interpreterProxy firstIndexableField: encoding) to: 'char *'. + self cCode: 'setNEncoding(&sqTextEncoding, name, len)'. + ^ encoding. + ! Item was added: + ----- Method: ImmX11Plugin>>primSetEncodingToLocale (in category 'primitives') ----- + primSetEncodingToLocale + + | ret | + <export: true> + self primitive: 'primSetEncodingToLocale'. + + (self cCode: '(int) localeEncoding') + ifFalse: [ ret := interpreterProxy falseObject ] + ifTrue: [ + self cCode: 'sqTextEncoding = (void *)localeEncoding'. + ret := interpreterProxy trueObject + ]. + ^ ret! Item was added: + ----- Method: ImmX11Plugin>>primSetLocale: (in category 'primitives') ----- + primSetLocale: locale + + | name len ret array | + <export: true> + <var: #name type: 'char *'> + <var: #array type: 'char *'> + <var: #len type: 'size_t'> + len := interpreterProxy stSizeOf: locale. + name := self cCoerce: (interpreterProxy arrayValueOf: locale) to: 'char *'. + name := self cCode: 'setLocale(name, len)'. + (self cCode: '(int) name') + ifFalse: [^ interpreterProxy nilObject ] + ifTrue: [ + len := self cCode: 'strlen(name)'. + ret := interpreterProxy + instantiateClass: interpreterProxy classString + indexableSize: len. + array := self cCoerce: (interpreterProxy firstIndexableField: ret) to: 'char *'. + self cCode: 'strncpy(array, (char *)name, len)'. + ^ ret ]. + ! Item was added: + ----- Method: ImmX11Plugin>>primSetLocaleEncoding: (in category 'primitives') ----- + primSetLocaleEncoding: encoding + + | name len | + <export: true> + <var: #name type: 'char *'> + <var: #len type: 'size_t'> + len := interpreterProxy stSizeOf: encoding. + name := self cCoerce: (interpreterProxy firstIndexableField: encoding) to: 'char *'. + self cCode: 'setNEncoding(&localeEncoding, name, len)'. + self cCode: 'sqTextEncoding= uxTextEncoding= uxPathEncoding= uxXWinEncoding= localeEncoding'. + ^ encoding. + ! Item was added: + ----- Method: ImmX11Plugin>>primSetPathEnc: (in category 'primitives') ----- + primSetPathEnc: encoding + + | name len | + <export: true> + <var: #name type: 'char *'> + <var: #len type: 'size_t'> + len := interpreterProxy stSizeOf: encoding. + name := self cCoerce: (interpreterProxy firstIndexableField: encoding) to: 'char *'. + self cCode: 'setNEncoding(&uxPathEncoding, name, len)'. + ^ encoding.! Item was added: + ----- Method: ImmX11Plugin>>primSetPathEncToLocale (in category 'primitives') ----- + primSetPathEncToLocale + + | ret | + <export: true> + self primitive: 'primSetPathEncToLocale'. + + (self cCode: '(int) localeEncoding') + ifFalse: [ ret := interpreterProxy falseObject ] + ifTrue: [ + self cCode: 'uxPathEncoding = (void *)localeEncoding'. + ret := interpreterProxy trueObject + ]. + ^ ret! Item was added: + ----- Method: ImmX11Plugin>>primSetTextEnc: (in category 'primitives') ----- + primSetTextEnc: encoding + + | name len | + <export: true> + <var: #name type: 'char *'> + <var: #len type: 'size_t'> + len := interpreterProxy stSizeOf: encoding. + name := self cCoerce: (interpreterProxy firstIndexableField: encoding) to: 'char *'. + self cCode: 'setNEncoding(&uxTextEncoding, name, len)'. + ^ encoding.! Item was added: + ----- Method: ImmX11Plugin>>primSetTextEncToLocale (in category 'primitives') ----- + primSetTextEncToLocale + + | ret | + <export: true> + self primitive: 'primSetTextEncToLocale'. + + (self cCode: '(int) localeEncoding') + ifFalse: [ ret := interpreterProxy falseObject ] + ifTrue: [ + self cCode: 'uxTextEncoding = (void *)localeEncoding'. + ret := interpreterProxy trueObject + ]. + ^ ret! Item was added: + ----- Method: ImmX11Plugin>>primSetTextEncUTF8: (in category 'primitives') ----- + primSetTextEncUTF8: bool + + <export: true> + self primitive: 'primSetTextEncUTF8' + parameters: #(Boolean). + self cCode: 'textEncodingUTF8 = bool'. + ^ bool asOop: Boolean.! Item was added: + ----- Method: ImmX11Plugin>>primSetXWinEnc: (in category 'primitives') ----- + primSetXWinEnc: encoding + + | name len | + <export: true> + <var: #name type: 'char *'> + <var: #len type: 'size_t'> + len := interpreterProxy stSizeOf: encoding. + name := self cCoerce: (interpreterProxy firstIndexableField: encoding) to: 'char *'. + self cCode: 'setNEncoding(&uxXWinEncoding, name, len)'. + ^ encoding.! Item was added: + ----- Method: ImmX11Plugin>>primSetXWinEncToLocale (in category 'primitives') ----- + primSetXWinEncToLocale + + | ret | + <export: true> + self primitive: 'primSetXWinEncToLocale'. + + (self cCode: '(int) localeEncoding') + ifFalse: [ ret := interpreterProxy falseObject ] + ifTrue: [ + self cCode: 'uxXWinEncoding = (void *)localeEncoding'. + ret := interpreterProxy trueObject + ]. + ^ ret! Item was added: + ----- Method: ImmX11Plugin>>shutdownModule (in category 'initialize-release') ----- + shutdownModule + + <export: true> + ^ true + ! Item was changed: ----- Method: Interpreter>>stObject:at:put: (in category 'array primitive support') ----- stObject: array at: index put: value "Do what ST would return for <obj> at: index put: value." | hdr fmt totalLength fixedFields stSize | <inline: false> hdr := self baseHeader: array. fmt := (hdr >> 8) bitAnd: 16rF. totalLength := self lengthOf: array baseHeader: hdr format: fmt. fixedFields := self fixedFieldsOf: array format: fmt length: totalLength. (fmt = 3 and: [self isContextHeader: hdr]) ifTrue: [stSize := self fetchStackPointerOf: array] ifFalse: [stSize := totalLength - fixedFields]. ((self oop: index isGreaterThanOrEqualTo: 1) and: [self oop: index isLessThanOrEqualTo: stSize]) ifTrue: [self subscript: array with: (index + fixedFields) storing: value format: fmt] + ifFalse: [successFlag := false]. + ^value! - ifFalse: [successFlag := false]! Item was added: + ----- Method: InterpreterPlugin>>expandDereferenceInterpreterProxyFunctionTable (in category 'initialize') ----- + expandDereferenceInterpreterProxyFunctionTable + "This is a dummy funciton that the VMPluginCodeGenerator expands into a + sequence of assignments from interpreterProxy funcitons to local function pointers."! Item was added: + ----- Method: InterpreterPlugin>>majorVersion (in category 'simulation support') ----- + majorVersion + "This is implemented in sqVirtualMachine.c, so this form is for simulation only." + <doNotGenerate> + ^1! Item was added: + ----- Method: InterpreterPlugin>>minorVersion (in category 'simulation support') ----- + minorVersion + "This is implemented in sqVirtualMachine.c, so this form is for simulation only." + <doNotGenerate> + ^8! Item was changed: ----- Method: InterpreterPlugin>>setInterpreter: (in category 'initialize') ----- setInterpreter: anInterpreter + "Note: This is coded so that it can be run in Squeak." - "Note: This is coded so that is can be run from Squeak." | ok | <export: true> <var: #anInterpreter type: #'struct VirtualMachine*'> interpreterProxy := anInterpreter. + ok := interpreterProxy majorVersion = (self cCode: 'VM_PROXY_MAJOR' inSmalltalk: [self majorVersion]) + and: [interpreterProxy minorVersion >= (self cCode: 'VM_PROXY_MINOR' inSmalltalk: [self minorVersion])]. + ok ifTrue: + [self expandDereferenceInterpreterProxyFunctionTable]. + ^ok! - ok := self cCode: 'interpreterProxy->majorVersion() == VM_PROXY_MAJOR'. - ok == false ifTrue: [^ false]. - ok := self cCode: 'interpreterProxy->minorVersion() >= VM_PROXY_MINOR'. - ^ ok! Item was added: + ----- Method: InterpreterProxy class>>implicitReturnTypeFor: (in category 'translation') ----- + implicitReturnTypeFor: aSelector + "Answer the return type for methods that don't have an explicit return." + ^#sqInt! Item was added: + ----- Method: InterpreterProxy>>disownVM: (in category 'FFI support') ----- + disownVM: flags + self error: 'not yet implemented in Smalltalk'! Item was added: + ----- Method: InterpreterProxy>>getInterruptPending (in category 'other') ----- + getInterruptPending + self error: 'not yet implemented in Smalltalk'! Item was changed: ----- Method: InterpreterProxy>>getStackPointer (in category 'other') ----- getStackPointer + <returnTypeC: #'sqInt *'> self error: 'not yet implemented in Smalltalk'! Item was changed: ----- Method: InterpreterProxy>>ioFilename:fromString:ofLength:resolveAliases: (in category 'converting') ----- ioFilename: aCharBuffer fromString: aFilenameString ofLength: filenameLength resolveAliases: aBoolean + <var: #aCharBuffer type: #'char *'> + <var: #aFilenameString type: #'char *'> "the vm has to convert aFilenameString via any canonicalization and char-mapping and put the result in aCharBuffer. This doesn't translate well in Smalltalk since we know how long strings are rather than considering them terminated by a 0 char. Do the best we can. Note the resolveAliases flag - this is an awful artefact of OSX and Apples demented alias handling. When opening a file, the flag must be true, when closing or renaming it must be false. Sigh." aCharBuffer replaceFrom:1 to: filenameLength with: aFilenameString! Item was changed: ----- Method: InterpreterProxy>>ioLoadFunction:From: (in category 'FFI support') ----- ioLoadFunction: functionName From: moduleName + <returnTypeC: #'void *'> + <var: #functionName type: #'char *'> + <var: #moduleName type: #'char *'> "Dummy - provided by support code" ^0! Item was changed: ----- Method: InterpreterProxy>>ioLoadModule:OfLength: (in category 'FFI support') ----- ioLoadModule: moduleNameIndex OfLength: moduleLength + <returnTypeC: #'void *'> "Dummy - provided by support code" ^0! Item was changed: ----- Method: InterpreterProxy>>ioLoadSymbol:OfLength:FromModule: (in category 'FFI support') ----- ioLoadSymbol: functionNameIndex OfLength: functionLength FromModule: moduleHandle + <returnTypeC: #'void *'> "Dummy - provided by support code" ^0! Item was added: + ----- Method: InterpreterProxy>>isYoung: (in category 'FFI support') ----- + isYoung: anOop + self error: 'not yet implemented in Smalltalk'! Item was added: + ----- Method: InterpreterProxy>>ownVM: (in category 'FFI support') ----- + ownVM: flags + self error: 'not yet implemented in Smalltalk'! Item was changed: ----- Method: InterpreterProxy>>positive64BitIntegerFor: (in category 'converting') ----- positive64BitIntegerFor: integerValue + <var: 'integerValue' type: #sqLong> integerValue isInteger ifFalse:[self error:'Not an Integer object']. ^integerValue > 0 ifTrue:[integerValue] ifFalse:[ (1 bitShift: 64) + integerValue]! Item was changed: ----- Method: InterpreterProxy>>positive64BitValueOf: (in category 'converting') ----- positive64BitValueOf: oop + <returnTypeC: #sqLong> oop isInteger ifFalse:[self error:'Not an integer object']. oop < 0 ifTrue:[self primitiveFail. ^0] ifFalse:[^oop]! Item was changed: ----- Method: InterpreterProxy>>positiveMachineIntegerValueOf: (in category 'converting') ----- positiveMachineIntegerValueOf: oop + <returnTypeC: #'unsigned long'> oop isInteger ifFalse:[self error: 'Not an integer object']. ^oop < 0 ifTrue: [self primitiveFail. 0] ifFalse: [oop]! Item was changed: ----- Method: InterpreterProxy>>returnAs:ThroughCallback:Context: (in category 'callback support') ----- returnAs: returnTypeOop ThroughCallback: vmCallbackContext Context: callbackMethodContext + <var: #vmCallbackContext type: #'VMCallbackContext *'> "callbackMethodContext is an activation of invokeCallback:[stack:registers:jmpbuf:]. Its sender is the VM's state prior to the callback. Reestablish that state (via longjmp), and mark callbackMethodContext as dead." self notYetImplemented! Item was changed: ----- Method: InterpreterProxy>>sendInvokeCallbackContext: (in category 'callback support') ----- sendInvokeCallbackContext: vmCallbackContext + <var: #vmCallbackContext type: #'VMCallbackContext *'> "Send the calllback message to Alien class with the supplied arg(s). Use either the 1 arg invokeCallbackContext: or the 4 arg invokeCallback:stack:registers:jmpbuf: message, depending on what selector is installed in the specialObjectsArray. Note that if invoking the legacy invokeCallback:stack:registers:jmpbuf: we pass the vmCallbackContext as the jmpbuf argument (see reestablishContextPriorToCallback:). The arguments are raw C addresses and are converted to integer objects on the way." self notYetImplemented! Item was changed: ----- Method: InterpreterProxy>>setInterruptCheckChain: (in category 'other') ----- setInterruptCheckChain: aFunction + <returnTypeC: 'void (*setInterruptCheckChain(void (*aFunction)(void)))()'> + <var: #aFunction declareC: 'void (*aFunction)()'> self error: 'not yet implemented in Smalltalk'! Item was added: + ----- Method: InterpreterProxy>>signalNoResume: (in category 'callback support') ----- + signalNoResume: aSemaphore + self error: 'not yet implemented in Smalltalk'! Item was changed: ----- Method: InterpreterProxy>>signed32BitValueOf: (in category 'converting') ----- signed32BitValueOf: oop + <returnTypeC: #int> oop isInteger ifFalse:[self error:'Not an integer object']. ^oop! Item was changed: ----- Method: InterpreterProxy>>signed64BitIntegerFor: (in category 'converting') ----- signed64BitIntegerFor: integerValue + <var: 'integerValue' type: #sqLong> integerValue isInteger ifFalse:[self error:'Not an Integer object']. ^integerValue! Item was changed: ----- Method: InterpreterProxy>>signed64BitValueOf: (in category 'converting') ----- signed64BitValueOf: oop + <returnTypeC: #sqLong> oop isInteger ifFalse:[self error:'Not an integer object']. ^oop! Item was changed: ----- Method: InterpreterProxy>>signedMachineIntegerValueOf: (in category 'converting') ----- signedMachineIntegerValueOf: oop + <returnTypeC: #'long'> oop isInteger ifFalse:[self error:'Not an integer object']. ^oop! Item was changed: ----- Method: LargeIntegersPlugin>>digitMontgomery:times:modulo:mInvModB: (in category 'oop functions') ----- digitMontgomery: firstLarge times: secondLarge modulo: thirdLarge mInvModB: mInv | firstLen secondLen thirdLen prod | <var: #over type: 'unsigned char '> firstLen := self byteSizeOfBytes: firstLarge. secondLen := self byteSizeOfBytes: secondLarge. thirdLen := self byteSizeOfBytes: thirdLarge. + firstLen <= thirdLen ifFalse: [^interpreterProxy primitiveFail]. + secondLen <= thirdLen ifFalse: [^interpreterProxy primitiveFail]. + (mInv >= 0 and: [mInv <= 255]) ifFalse: [^interpreterProxy primitiveFail]. - firstLen <= thirdLen ifFalse: [^self error: 'firstLarge must be less than thirdLarge']. - secondLen <= thirdLen ifFalse: [^self error: 'secondLarge must be less than thirdLarge']. - (mInv >= 0 and: [mInv <= 255]) ifFalse: [^self error: 'mInvMod256 must be between 0 and 255']. self remapOop: #(firstLarge secondLarge thirdLarge) in: [prod := interpreterProxy instantiateClass: interpreterProxy classLargePositiveInteger indexableSize: thirdLen]. self cdigitMontgomery: (interpreterProxy firstIndexableField: firstLarge) len: firstLen times: (interpreterProxy firstIndexableField: secondLarge) len: secondLen modulo: (interpreterProxy firstIndexableField: thirdLarge) len: thirdLen mInvModB: mInv into: (interpreterProxy firstIndexableField: prod). ^self normalizePositive: prod! Item was changed: ----- Method: NewspeakInterpreter>>getStackPointer (in category 'primitive support') ----- getStackPointer "For Newsqueak FFI" <export: true> <returnTypeC: #'sqInt *'> + ^self cCoerce: stackPointer to: #'sqInt *'! - ^stackPointer! Item was changed: ----- Method: NewspeakInterpreter>>signed32BitIntegerFor: (in category 'primitive support') ----- signed32BitIntegerFor: integerValue "Return a full 32 bit integer object for the given integer value" | newLargeInteger value largeClass | <inline: false> - <var: #integerValue type: 'int'> (self isIntegerValue: integerValue) ifTrue: [^ self integerObjectOf: integerValue]. integerValue < 0 ifTrue:[ largeClass := self classLargeNegativeInteger. value := 0 - integerValue] ifFalse:[ largeClass := self classLargePositiveInteger. value := integerValue]. newLargeInteger := self instantiateClass: largeClass indexableSize: 4. self storeByte: 3 ofObject: newLargeInteger withValue: ((value >> 24) bitAnd: 16rFF). self storeByte: 2 ofObject: newLargeInteger withValue: ((value >> 16) bitAnd: 16rFF). self storeByte: 1 ofObject: newLargeInteger withValue: ((value >> 8) bitAnd: 16rFF). self storeByte: 0 ofObject: newLargeInteger withValue: (value bitAnd: 16rFF). ^ newLargeInteger! Item was changed: ----- Method: NewspeakInterpreter>>stObject:at:put: (in category 'indexing primitive support') ----- stObject: array at: index put: value "Do what ST would return for <obj> at: index put: value." | hdr fmt totalLength fixedFields stSize | <inline: false> hdr := self baseHeader: array. fmt := self formatOfHeader: hdr. totalLength := self lengthOf: array baseHeader: hdr format: fmt. fixedFields := self fixedFieldsOf: array format: fmt length: totalLength. (fmt = 3 and: [self isContextHeader: hdr]) ifTrue: [stSize := self fetchStackPointerOf: array] ifFalse: [stSize := totalLength - fixedFields]. ((self oop: index isGreaterThanOrEqualTo: 1) and: [self oop: index isLessThanOrEqualTo: stSize]) ifTrue: [self subscript: array with: (index + fixedFields) storing: value format: fmt] + ifFalse: [self primitiveFailFor: (fmt <= 1 ifTrue: [PrimErrBadReceiver] ifFalse: [PrimErrBadIndex])]. + ^value! - ifFalse: [self primitiveFailFor: (fmt <= 1 ifTrue: [PrimErrBadReceiver] ifFalse: [PrimErrBadIndex])]! Item was changed: ----- Method: NewsqueakIA32ABIPlugin>>primCallOutDoubleReturn (in category 'primitives-callouts') ----- primCallOutDoubleReturn "Call a foreign function that answers a double-precision floating-point result in %f0 according to IA32-ish ABI rules. The primitive will have a signature of the form functionAddress <Alien> primFFICallResult: result <Alien|Object> with: firstArg <Alien | Integer> ... with: lastArg <Alien | Integer> ^<Alien> <primitive: 'primCallOutDoubleReturn' error: errorCode module: 'IA32ABI'>. Answer result. If result is an Alien the value answered by the call will be assigned to result." | errCode mac result | <export: true> mac := interpreterProxy methodArgumentCount. self cppIf: STACKVM ifTrue: "In the STACKVM stacks grow down" + [errCode := self call: interpreterProxy getStackPointer + mac - 2 "ptr to 0th arg" + IA32: 1 - mac "nargs negated to imply stack direction" + Double: mac "funcOffset" + Return: mac - 1 "resultOffset"] - [self cCode: 'errCode = callIA32DoubleReturn(interpreterProxy->getStackPointer() + mac - 2, /* arg vec */ - 1 - mac /* nargs */, - mac /* funcOffset*/, - mac - 1 /* resultOffset */)' - inSmalltalk: [errCode := PrimErrUnsupported]] ifFalse: + [errCode := self call: interpreterProxy getStackPointer - mac + 2 "ptr to 0th arg" + IA32: mac - 1 "nargs" + Double: mac "funcOffset" + Return: mac - 1 "resultOffset"]. - [self cCode: 'errCode = callIA32DoubleReturn(interpreterProxy->getStackPointer() - mac + 2, /* arg vec */ - mac - 1 /* nargs */, - mac /* funcOffset*/, - mac - 1 /* resultOffset */)' - inSmalltalk: [errCode := PrimErrUnsupported]]. errCode ~= 0 ifTrue: [^interpreterProxy primitiveFailFor: errCode]. result := interpreterProxy stackValue: mac - 1. interpreterProxy pop: mac + 1 thenPush: result! Item was changed: ----- Method: NewsqueakIA32ABIPlugin>>primCallOutFloatReturn (in category 'primitives-callouts') ----- primCallOutFloatReturn "Call a foreign function that answers a single-precision floating-point result in %f0 according to IA32-ish ABI rules. The primitive will have a signature of the form functionAddress <Alien> primFFICallResult: result <Alien|Object> with: firstArg <Alien | Integer> ... with: lastArg <Alien | Integer> ^<Alien> <primitive: 'primCallOutFloatReturn' error: errorCode module: 'IA32ABI'>. Answer result. If result is an Alien the value answered by the call will be assigned to result." | errCode mac result | <export: true> mac := interpreterProxy methodArgumentCount. self cppIf: STACKVM ifTrue: "In the STACKVM stacks grow down" + [errCode := self call: interpreterProxy getStackPointer + mac - 2 "ptr to 0th arg" + IA32: 1 - mac "nargs negated to imply stack direction" + Float: mac "funcOffset" + Return: mac - 1 "resultOffset"] - [self cCode: 'errCode = callIA32FloatReturn(interpreterProxy->getStackPointer() + mac - 2, /* arg vec */ - 1 - mac /* nargs */, - mac /* funcOffset*/, - mac - 1 /* resultOffset */)' - inSmalltalk: [errCode := PrimErrUnsupported]] ifFalse: + [errCode := self call: interpreterProxy getStackPointer - mac + 2 "ptr to 0th arg" + IA32: mac - 1 "nargs" + Float: mac "funcOffset" + Return: mac - 1 "resultOffset"]. - [self cCode: 'errCode = callIA32FloatReturn(interpreterProxy->getStackPointer() - mac + 2, /* arg vec */ - mac - 1 /* nargs */, - mac /* funcOffset*/, - mac - 1 /* resultOffset */)' - inSmalltalk: [errCode := PrimErrUnsupported]]. errCode ~= 0 ifTrue: [^interpreterProxy primitiveFailFor: errCode]. result := interpreterProxy stackValue: mac - 1. interpreterProxy pop: mac + 1 thenPush: result! Item was changed: ----- Method: NewsqueakIA32ABIPlugin>>primCallOutIntegralReturn (in category 'primitives-callouts') ----- primCallOutIntegralReturn "Call a foreign function that answers an integral result in %eax (and possibly %edx) according to IA32-ish ABI rules. The primitive will have a signature of the form functionAddress <Alien> primFFICallResult: result <Alien|Object> with: firstArg <Alien | Integer> ... with: lastArg <Alien | Integer> ^<Alien> <primitive: 'primCallOutIntegralReturn' error: errorCode module: 'IA32ABI'>. Answer result. If result is an Alien the value answered by the call will be assigned to result." | errCode mac result | <export: true> mac := interpreterProxy methodArgumentCount. self cppIf: STACKVM ifTrue: "In the STACKVM stacks grow down" + [errCode := self call: interpreterProxy getStackPointer + mac - 2 "ptr to 0th arg" + IA32: 1 - mac "nargs negated to imply stack direction" + Integral: mac "funcOffset" + Return: mac - 1 "resultOffset"] - [self cCode: 'errCode = callIA32IntegralReturn(interpreterProxy->getStackPointer() + mac - 2, /* arg vec */ - 1 - mac /* nargs */, - mac /* funcOffset*/, - mac - 1 /* resultOffset */)' - inSmalltalk: [errCode := PrimErrUnsupported]] ifFalse: + [errCode := self call: interpreterProxy getStackPointer - mac + 2 "ptr to 0th arg" + IA32: mac - 1 "nargs" + Integral: mac "funcOffset" + Return: mac - 1 "resultOffset"]. - [self cCode: 'errCode = callIA32IntegralReturn(interpreterProxy->getStackPointer() - mac + 2, /* arg vec */ - mac - 1 /* nargs */, - mac /* funcOffset*/, - mac - 1 /* resultOffset */)' - inSmalltalk: [errCode := PrimErrUnsupported]]. errCode ~= 0 ifTrue: [^interpreterProxy primitiveFailFor: errCode]. result := interpreterProxy stackValue: mac - 1. interpreterProxy pop: mac + 1 thenPush: result! Item was changed: ----- Method: NewsqueakIA32ABIPlugin>>primVarArgsCallOutDoubleReturn (in category 'primitives-callouts') ----- primVarArgsCallOutDoubleReturn "Call a foreign function that answers a double-precision floating-point result in %f0 according to IA32-ish ABI rules. The primitive will have a signature of the form functionAddress <Alien> primFFICallResult: result <Alien|Object> withArguments: args <Array of: Alien | Integer> ^<Alien> <primitive: 'primVarArgsCallOutDoubleReturn' error: errorCode module: 'IA32ABI'>. Answer result. If result is an Alien the value answered by the call will be assigned to result." | array mac errCode result | <export: true> array := interpreterProxy stackValue: 0. (interpreterProxy isArray: array) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. mac := interpreterProxy methodArgumentCount. + errCode := self call: (interpreterProxy firstIndexableField: array) "ptr to 0th arg" + IA32: (interpreterProxy stSizeOf: array) "nargs" + Double: 2 "func stackValue" + Return: 1. "result stackValue" - self cCode: 'errCode = callIA32DoubleReturn(interpreterProxy->firstIndexableField(array), /* arg vec */ - interpreterProxy->stSizeOf(array) /* nargs */, - 2 /* funcOffset*/, - 1 /* resultOffset */)' - inSmalltalk: [errCode := PrimErrUnsupported]. errCode ~= 0 ifTrue: [^interpreterProxy primitiveFailFor: errCode]. result := interpreterProxy stackValue: 1. interpreterProxy pop: mac + 1 thenPush: result! Item was changed: ----- Method: NewsqueakIA32ABIPlugin>>primVarArgsCallOutFloatReturn (in category 'primitives-callouts') ----- primVarArgsCallOutFloatReturn "Call a foreign function that answers a single-precision floating-point result in %f0 according to IA32-ish ABI rules. The primitive will have a signature of the form functionAddress <Alien> primFFICallResult: result <Alien|Object> withArguments: args <Array of: Alien | Integer> ^<Alien> <primitive: 'primVarArgsCallOutFloatReturn' error: errorCode module: 'IA32ABI'>. Answer result. If result is an Alien the value answered by the call will be assigned to result." | array mac errCode result | <export: true> array := interpreterProxy stackValue: 0. (interpreterProxy isArray: array) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. mac := interpreterProxy methodArgumentCount. + errCode := self call: (interpreterProxy firstIndexableField: array) "ptr to 0th arg" + IA32: (interpreterProxy stSizeOf: array) "nargs" + Float: 2 "func stackValue" + Return: 1. "result stackValue" - self cCode: 'errCode = callIA32FloatReturn(interpreterProxy->firstIndexableField(array), /* arg vec */ - interpreterProxy->stSizeOf(array) /* nargs */, - 2 /* funcOffset*/, - 1 /* resultOffset */)' - inSmalltalk: [errCode := PrimErrUnsupported]. errCode ~= 0 ifTrue: [^interpreterProxy primitiveFailFor: errCode]. result := interpreterProxy stackValue: 1. interpreterProxy pop: mac + 1 thenPush: result! Item was changed: ----- Method: NewsqueakIA32ABIPlugin>>primVarArgsCallOutIntegralReturn (in category 'primitives-callouts') ----- primVarArgsCallOutIntegralReturn "Call a foreign function that answers an integral result in %eax (and possibly %edx) according to IA32-ish ABI rules. The primitive will have a signature of the form functionAddress <Alien> primFFICallResult: result <Alien|Object> withArguments: args <Array of: Alien | Integer> ^<Alien> <primitive: 'primVarArgsCallOutIntegralReturn' error: errorCode module: 'IA32ABI'>. Answer result. If result is an Alien the value answered by the call will be assigned to result." | array mac errCode result | <export: true> array := interpreterProxy stackValue: 0. (interpreterProxy isArray: array) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. mac := interpreterProxy methodArgumentCount. + errCode := self call: (interpreterProxy firstIndexableField: array) "ptr to 0th arg" + IA32: (interpreterProxy stSizeOf: array) "nargs" + Integral: 2 "func stackValue" + Return: 1. "result stackValue" - self cCode: 'errCode = callIA32IntegralReturn(interpreterProxy->firstIndexableField(array), /* arg vec */ - interpreterProxy->stSizeOf(array) /* nargs */, - 2 /* funcOffset*/, - 1 /* resultOffset */)' - inSmalltalk: [errCode := PrimErrUnsupported]. errCode ~= 0 ifTrue: [^interpreterProxy primitiveFailFor: errCode]. result := interpreterProxy stackValue: 1. interpreterProxy pop: mac + 1 thenPush: result! Item was changed: ----- Method: NewsqueakIA32ABIPlugin>>setInterpreter: (in category 'initialize') ----- setInterpreter: anInterpreter "Note: This is coded so that is can be run from Squeak." | ok | <export: true> <var: #anInterpreter type: #'struct VirtualMachine*'> interpreterProxy := anInterpreter. ok := interpreterProxy majorVersion = 1 and: [interpreterProxy minorVersion >= 12]. + ok ifTrue: + [self expandDereferenceInterpreterProxyFunctionTable]. ^ok! Item was removed: - ----- Method: SmartSyntaxPluginCodeGenerator>>emitLoad:asBooleanValueFrom:on: (in category 'linking') ----- - emitLoad: aString asBooleanValueFrom: anInteger on: aStream - - aStream - nextPutAll: aString; - nextPutAll: ' = interpreterProxy->booleanValueOf('; - crtab: 2; - nextPutAll: 'interpreterProxy->stackValue('; - nextPutAll: anInteger asString; - nextPutAll: '))'! Item was removed: - ----- Method: SmartSyntaxPluginCodeGenerator>>emitLoad:asCharPtrFrom:on: (in category 'linking') ----- - emitLoad: aString asCharPtrFrom: anInteger on: aStream - - aStream - nextPutAll: aString; - nextPutAll: ' = (char *) interpreterProxy->firstIndexableField('; - crtab: 2; - nextPutAll: 'interpreterProxy->stackValueOf('; - nextPutAll: anInteger asString; - nextPutAll: '))'! Item was removed: - ----- Method: SmartSyntaxPluginCodeGenerator>>emitLoad:asFloatPtrFrom:on: (in category 'linking') ----- - emitLoad: aString asFloatPtrFrom: anInteger on: aStream - - aStream - nextPutAll: aString; - nextPutAll: ' = (float *) interpreterProxy->firstIndexableField('; - crtab: 2; - nextPutAll: 'interpreterProxy->stackValueOf('; - nextPutAll: anInteger asString; - nextPutAll: '))'! Item was removed: - ----- Method: SmartSyntaxPluginCodeGenerator>>emitLoad:asFloatValueFrom:on: (in category 'linking') ----- - emitLoad: aString asFloatValueFrom: anInteger on: aStream - - aStream - nextPutAll: aString; - nextPutAll: ' = interpreterProxy->stackFloatValue('; - nextPutAll: anInteger asString; - nextPutAll: ')'! Item was removed: - ----- Method: SmartSyntaxPluginCodeGenerator>>emitLoad:asIntPtrFrom:on: (in category 'linking') ----- - emitLoad: aString asIntPtrFrom: anInteger on: aStream - - aStream - nextPutAll: aString; - nextPutAll: ' = (int *) interpreterProxy->firstIndexableField('; - crtab: 2; - nextPutAll: 'interpreterProxy->stackValueOf('; - nextPutAll: anInteger asString; - nextPutAll: '))'! Item was removed: - ----- Method: SmartSyntaxPluginCodeGenerator>>emitLoad:asIntegerValueFrom:on: (in category 'linking') ----- - emitLoad: aString asIntegerValueFrom: anInteger on: aStream - - aStream - nextPutAll: aString; - nextPutAll: ' = interpreterProxy stackIntegerValue('; - nextPutAll: anInteger asString; - nextPutAll: ')'! Item was removed: - ----- Method: SmartSyntaxPluginCodeGenerator>>emitLoad:asKindOf:from:on: (in category 'linking') ----- - emitLoad: aString asKindOf: aClass from: anInteger on: aStream - - self emitLoad: aString asNakedOopFrom: anInteger on: aStream. - aStream - crtab; - nextPutAll: 'interpreterProxy->success(interpreterProxy->isKindOf('; - nextPutAll: aString; - nextPutAll: ', '''; - nextPutAll: aClass asString; - nextPutAll: '''))'! Item was removed: - ----- Method: SmartSyntaxPluginCodeGenerator>>emitLoad:asMemberOf:from:on: (in category 'linking') ----- - emitLoad: aString asMemberOf: aClass from: anInteger on: aStream - - self emitLoad: aString asNakedOopFrom: anInteger on: aStream. - aStream - crtab; - nextPutAll: 'interpreterProxy->success(interpreterProxy->isMemberOf('; - nextPutAll: aString; - nextPutAll: ', '''; - nextPutAll: aClass asString; - nextPutAll: '''))'! Item was removed: - ----- Method: SmartSyntaxPluginCodeGenerator>>emitLoad:asNakedOopFrom:on: (in category 'linking') ----- - emitLoad: aString asNakedOopFrom: anInteger on: aStream - - aStream - nextPutAll: aString; - nextPutAll: ' = interpreterProxy stackValue('; - nextPutAll: anInteger asString; - nextPutAll: ')'! Item was removed: - ----- Method: SmartSyntaxPluginCodeGenerator>>emitLoad:asNonIntegerValueFrom:on: (in category 'linking') ----- - emitLoad: aString asNonIntegerValueFrom: anInteger on: aStream - - aStream - nextPutAll: aString; - nextPutAll: ' = interpreterProxy stackObjectValue('; - nextPutAll: anInteger asString; - nextPutAll: ')'! Item was removed: - ----- Method: SmartSyntaxPluginCodeGenerator>>emitLoad:asUnsignedValueFrom:on: (in category 'linking') ----- - emitLoad: aString asUnsignedValueFrom: anInteger on: aStream - - aStream - nextPutAll: aString; - nextPutAll: ' = interpreterProxy->positive32BitValueOf('; - crtab: 2; - nextPutAll: 'interpreterProxy->stackValue('; - nextPutAll: anInteger asString; - nextPutAll: '))'! Item was added: + ----- Method: SmartSyntaxPluginCodeGenerator>>genCallOf:with:on: (in category 'translating builtins') ----- + genCallOf: aSelector with: aNode on: aStream + pluginFunctionsUsed add: aSelector. + aStream nextPutAll: (self cFunctionNameFor: aSelector). + aStream nextPut: $(. + self emitCExpression: aNode on: aStream. + aStream nextPut: $)! Item was added: + ----- Method: SmartSyntaxPluginCodeGenerator>>genCallOf:with:with:on: (in category 'translating builtins') ----- + genCallOf: aSelector with: firstArgNode with: secondArgNode on: aStream + pluginFunctionsUsed add: aSelector. + aStream nextPutAll: (self cFunctionNameFor: aSelector). + aStream nextPut: $(. + self emitCExpression: firstArgNode on: aStream. + aStream nextPut: $,. + self emitCExpression: secondArgNode on: aStream. + aStream nextPut: $)! Item was added: + ----- Method: SmartSyntaxPluginCodeGenerator>>genCallOf:with:with:with:on: (in category 'translating builtins') ----- + genCallOf: aSelector with: firstArgNode with: secondArgNode with: thirdArgNode on: aStream + pluginFunctionsUsed add: aSelector. + aStream nextPutAll: (self cFunctionNameFor: aSelector). + aStream nextPut: $(. + self emitCExpression: firstArgNode on: aStream. + aStream nextPut: $,. + self emitCExpression: secondArgNode on: aStream. + aStream nextPut: $,. + self emitCExpression: thirdArgNode on: aStream. + aStream nextPut: $)! Item was changed: ----- Method: SmartSyntaxPluginCodeGenerator>>generateAsBooleanObj:on:indent: (in category 'translating builtins') ----- generateAsBooleanObj: aNode on: aStream indent: anInteger + pluginFunctionsUsed add: #trueObject; add: #falseObject. + aStream nextPutAll: '(('. - - aStream nextPutAll: '('. self emitCExpression: aNode receiver on: aStream. + aStream nextPutAll: ') ? trueObject() : falseObject())'.! - aStream nextPutAll: - ') ? interpreterProxy->trueObject(): interpreterProxy->falseObject()'.! Item was changed: ----- Method: SmartSyntaxPluginCodeGenerator>>generateAsCBoolean:on:indent: (in category 'translating builtins') ----- generateAsCBoolean: aNode on: aStream indent: anInteger + self genCallOf: #booleanValueOf: with: aNode receiver on: aStream! - - aStream nextPutAll: 'interpreterProxy->booleanValueOf('. - self emitCExpression: aNode receiver on: aStream. - aStream nextPutAll: ')'.! Item was changed: ----- Method: SmartSyntaxPluginCodeGenerator>>generateAsCDouble:on:indent: (in category 'translating builtins') ----- generateAsCDouble: aNode on: aStream indent: anInteger + self genCallOf: #floatValueOf: with: aNode receiver on: aStream! - - aStream nextPutAll: 'interpreterProxy->floatValueOf('. - self emitCExpression: aNode receiver on: aStream. - aStream nextPutAll: ')'.! Item was changed: ----- Method: SmartSyntaxPluginCodeGenerator>>generateAsCUnsigned:on:indent: (in category 'translating builtins') ----- generateAsCUnsigned: aNode on: aStream indent: anInteger + self genCallOf: #positive32BitValueOf: with: aNode receiver on: aStream! - - aStream nextPutAll: 'interpreterProxy->positive32BitValueOf('. - self emitCExpression: aNode receiver on: aStream. - aStream nextPutAll: ')'.! Item was changed: ----- Method: SmartSyntaxPluginCodeGenerator>>generateAsCharPtr:on:indent: (in category 'translating builtins') ----- generateAsCharPtr: aNode on: aStream indent: anInteger + self generateCoerceToPtr: 'char *' fromObject: aNode receiver on: aStream! - - aStream nextPutAll: '(char *) interpreterProxy->firstIndexableField('. - self emitCExpression: aNode receiver on: aStream. - aStream nextPutAll: ')'.! Item was changed: ----- Method: SmartSyntaxPluginCodeGenerator>>generateAsFloatObj:on:indent: (in category 'translating builtins') ----- generateAsFloatObj: aNode on: aStream indent: anInteger + self genCallOf: #floatObjectOf: with: aNode receiver on: aStream! - - aStream nextPutAll: 'interpreterProxy->floatObjectOf('. - self emitCExpression: aNode receiver on: aStream. - aStream nextPutAll: ')'.! Item was changed: ----- Method: SmartSyntaxPluginCodeGenerator>>generateAsIfVar:on:indent: (in category 'translating builtins') ----- generateAsIfVar: aNode on: aStream indent: anInteger | cName fName class index | cName := String streamContents: [:scStr | self emitCExpression: aNode args first on: scStr]. + (class := Smalltalk classNamed: cName) isBehavior ifFalse: - class := Smalltalk - at: (cName asSymbol) - ifAbsent: [nil]. - (class isNil not and: [class isBehavior]) ifFalse: [^self error: 'first arg must identify class']. fName := aNode args second value. + index := class + instVarIndexFor: fName + ifAbsent: [^self error: 'second arg must be instVar']. + pluginFunctionsUsed add: #fetchPointer:ofObject:. + aStream nextPutAll: 'fetchPointerofObject('; print: index - 1; nextPut: $,. - index := class allInstVarNames - indexOf: fName - ifAbsent: [^self error: 'second arg must be instVar']. - aStream - nextPutAll: 'interpreterProxy->fetchPointerofObject('; - nextPutAll: (index - 1) asString; - nextPutAll: ','. self emitCExpression: aNode receiver on: aStream. + aStream nextPut: $)! - aStream nextPutAll: ')'.! Item was changed: ----- Method: SmartSyntaxPluginCodeGenerator>>generateAsIfVarAsValue:on:indent: (in category 'translating builtins') ----- generateAsIfVarAsValue: aNode on: aStream indent: anInteger | cName fName class index fetchNode | cName := String streamContents: + [:scStr | self emitCExpression: aNode args first on: scStr]. + (class := Smalltalk classNamed: cName) isBehavior ifFalse: - [:scStr | self emitCExpression: aNode args first on: scStr]. - class := Smalltalk - at: (cName asSymbol) - ifAbsent: [nil]. - (class isNil not and: [class isBehavior]) ifFalse: [^self error: 'first arg must identify class']. fName := aNode args second value. + index := class + instVarIndexFor: fName + ifAbsent: [^self error: 'second arg must be instVar']. - index := class allInstVarNames - indexOf: fName - ifAbsent: [^self error: 'second arg must be instVar']. fetchNode := TSendNode new + setSelector: #fetchPointer:ofObject: + receiver: (TVariableNode new setName: 'self') + arguments: { TConstantNode new setValue: index - 1. aNode receiver}. - setSelector: #fetchPointer:ofObject: - receiver: (TVariableNode new setName: 'interpreterProxy') - arguments: (Array - with: (TConstantNode new setValue: index - 1) - with: aNode receiver). cName := aNode args third nameOrValue. + (class := Smalltalk classNamed: cName) isBehavior ifFalse: - class := Smalltalk - at: (cName asSymbol) - ifAbsent: [nil]. - (class isNil not and: [class isBehavior]) ifFalse: [^self error: 'third arg must identify class']. class ccg: self generateCoerceToValueFrom: fetchNode on: aStream ! Item was changed: ----- Method: SmartSyntaxPluginCodeGenerator>>generateAsIfVarPut:on:indent: (in category 'translating builtins') ----- generateAsIfVarPut: aNode on: aStream indent: anInteger | cName fName class index | cName := String streamContents: [:scStr | self emitCExpression: aNode args first on: scStr]. + (class := Smalltalk classNamed: cName) isBehavior ifFalse: - class := Smalltalk - at: (cName asSymbol) - ifAbsent: [nil]. - (class isNil not and: [class isBehavior]) ifFalse: [^self error: 'first arg must identify class']. fName := aNode args second value. + index := class + instVarIndexFor: fName + ifAbsent: [^self error: 'second arg must be instVar']. + pluginFunctionsUsed add: #storePointer:ofObject:withValue:. + aStream nextPutAll: 'storePointerofObjectwithValue('; print: index - 1; nextPut: $,. - index := class allInstVarNames - indexOf: fName - ifAbsent: [^self error: 'second arg must be instVar']. - aStream - nextPutAll: 'interpreterProxy->storePointerofObjectwithValue('; - nextPutAll: (index - 1) asString; - nextPutAll: ','. self emitCExpression: aNode receiver on: aStream. + aStream nextPut: $,. - aStream nextPutAll: ','. self emitCExpression: aNode args third on: aStream. + aStream nextPut: $)! - aStream nextPutAll: ')'.! Item was changed: ----- Method: SmartSyntaxPluginCodeGenerator>>generateAsIntPtr:on:indent: (in category 'translating builtins') ----- generateAsIntPtr: aNode on: aStream indent: anInteger + self generateCoerceToPtr: 'int *' fromObject: aNode receiver on: aStream! - - aStream nextPutAll: '(int *) interpreterProxy->firstIndexableField('. - self emitCExpression: aNode receiver on: aStream. - aStream nextPutAll: ')'.! Item was changed: ----- Method: SmartSyntaxPluginCodeGenerator>>generateAsPositiveIntegerObj:on:indent: (in category 'translating builtins') ----- generateAsPositiveIntegerObj: aNode on: aStream indent: anInteger + self genCallOf: #positive32BitIntegerFor: with: aNode receiver on: aStream! - - aStream nextPutAll: 'interpreterProxy->positive32BitIntegerFor('. - self emitCExpression: aNode receiver on: aStream. - aStream nextPutAll: ')'.! Item was changed: ----- Method: SmartSyntaxPluginCodeGenerator>>generateAsSmallIntegerObj:on:indent: (in category 'translating builtins') ----- generateAsSmallIntegerObj: aNode on: aStream indent: anInteger + self genCallOf: #integerObjectOf: with: aNode receiver on: aStream! - - aStream nextPutAll: 'interpreterProxy->integerObjectOf('. - self emitCExpression: aNode receiver on: aStream. - aStream nextPutAll: ')'.! Item was changed: ----- Method: SmartSyntaxPluginCodeGenerator>>generateClass:on:indent: (in category 'translating builtins') ----- generateClass: aNode on: aStream indent: anInteger + self genCallOf: #fetchClassOf: with: aNode receiver on: aStream! - - aStream nextPutAll: 'interpreterProxy->fetchClassOf('. - self emitCExpression: aNode receiver on: aStream. - aStream nextPutAll: ')'.! Item was changed: ----- Method: SmartSyntaxPluginCodeGenerator>>generateCoerceToBooleanObjectFrom:on: (in category 'asOop:/asValue:') ----- generateCoerceToBooleanObjectFrom: aNode on: aStream + pluginFunctionsUsed add: #trueObject; add: #falseObject. + aStream nextPutAll: '(('. - - aStream nextPutAll: '('. self emitCExpression: aNode on: aStream. + aStream nextPutAll: ') ? trueObject() : falseObject())'! - aStream nextPutAll: '? interpreterProxy->trueObject(): interpreterProxy->falseObject())'! Item was changed: ----- Method: SmartSyntaxPluginCodeGenerator>>generateCoerceToBooleanValueFrom:on: (in category 'asOop:/asValue:') ----- generateCoerceToBooleanValueFrom: aNode on: aStream + self genCallOf: #booleanValueOf: with: aNode receiver on: aStream! - - aStream nextPutAll: 'interpreterProxy->booleanValueOf('. - self emitCExpression: aNode on: aStream. - aStream nextPutAll: ')'! Item was changed: ----- Method: SmartSyntaxPluginCodeGenerator>>generateCoerceToFloatObjectFrom:on: (in category 'asOop:/asValue:') ----- generateCoerceToFloatObjectFrom: aNode on: aStream + self genCallOf: #floatObjectOf: with: aNode on: aStream! - - aStream nextPutAll: 'interpreterProxy->floatObjectOf('. - self emitCExpression: aNode on: aStream. - aStream nextPutAll: ')'! Item was changed: ----- Method: SmartSyntaxPluginCodeGenerator>>generateCoerceToFloatValueFrom:on: (in category 'asOop:/asValue:') ----- generateCoerceToFloatValueFrom: aNode on: aStream + self genCallOf: #floatValueOf: with: aNode on: aStream! - - aStream nextPutAll: 'interpreterProxy->floatValueOf('. - self emitCExpression: aNode on: aStream. - aStream nextPutAll: ')'! Item was changed: ----- Method: SmartSyntaxPluginCodeGenerator>>generateCoerceToPtr:fromObject:on: (in category 'asOop:/asValue:') ----- generateCoerceToPtr: aString fromObject: aNode on: aStream "This code assumes no named instance variables" - aStream nextPutAll: '(('; nextPutAll: aString; + nextPut: $). + self genCallOf: #firstIndexableField: with: aNode on: aStream. + aStream nextPut: $)! - nextPutAll: ') interpreterProxy->firstIndexableField('. - self emitCExpression: aNode on: aStream. - aStream nextPutAll: '))'! Item was changed: ----- Method: SmartSyntaxPluginCodeGenerator>>generateCoerceToSmallIntegerObjectFrom:on: (in category 'asOop:/asValue:') ----- generateCoerceToSmallIntegerObjectFrom: aNode on: aStream + self genCallOf: #integerObjectOf: with: aNode on: aStream! - - aStream nextPutAll: 'interpreterProxy->integerObjectOf('. - self emitCExpression: aNode on: aStream. - aStream nextPutAll: ')'! Item was changed: ----- Method: SmartSyntaxPluginCodeGenerator>>generateCoerceToSmallIntegerValueFrom:on: (in category 'asOop:/asValue:') ----- generateCoerceToSmallIntegerValueFrom: aNode on: aStream + self genCallOf: #integerValueOf: with: aNode on: aStream! - - aStream nextPutAll: 'interpreterProxy->integerValueOf('. - self emitCExpression: aNode on: aStream. - aStream nextPutAll: ')'! Item was changed: ----- Method: SmartSyntaxPluginCodeGenerator>>generateCoerceToUnsignedObjectFrom:on: (in category 'asOop:/asValue:') ----- generateCoerceToUnsignedObjectFrom: aNode on: aStream + self genCallOf: #positive32BitIntegerFor: with: aNode on: aStream! - - aStream nextPutAll: 'interpreterProxy->positive32BitIntegerFor('. - self emitCExpression: aNode on: aStream. - aStream nextPutAll: ')'! Item was changed: ----- Method: SmartSyntaxPluginCodeGenerator>>generateCoerceToUnsignedValueFrom:on: (in category 'asOop:/asValue:') ----- generateCoerceToUnsignedValueFrom: aNode on: aStream + self genCallOf: #positive32BitValueOf: with: aNode on: aStream! - - aStream nextPutAll: 'interpreterProxy->positive32BitValueOf('. - self emitCExpression: aNode on: aStream. - aStream nextPutAll: ')'! Item was changed: ----- Method: SmartSyntaxPluginCodeGenerator>>generateField:on:indent: (in category 'translating builtins') ----- generateField: aNode on: aStream indent: anInteger + self genCallOf: #fetchPointer:ofObject: with: aNode args first with: aNode receiver on: aStream! - - aStream nextPutAll: 'interpreterProxy->fetchPointerofObject('. - self emitCExpression: aNode args first on: aStream. - aStream nextPutAll: ','. - self emitCExpression: aNode receiver on: aStream. - aStream nextPutAll: ')'.! Item was changed: ----- Method: SmartSyntaxPluginCodeGenerator>>generateFieldPut:on:indent: (in category 'translating builtins') ----- generateFieldPut: aNode on: aStream indent: anInteger + self genCallOf: #storePointer:ofObject:withValue: + with: aNode args first + with: aNode receiver + with: aNode args second + on: aStream! - - aStream nextPutAll: 'interpreterProxy->storePointerofObjectwithValue('. - self emitCExpression: aNode args first on: aStream. - aStream nextPutAll: ','. - self emitCExpression: aNode receiver on: aStream. - aStream nextPutAll: ','. - self emitCExpression: aNode args second on: aStream. - aStream nextPutAll: ')'.! Item was changed: ----- Method: SmartSyntaxPluginCodeGenerator>>generateFromStack:on:indent: (in category 'translating builtins') ----- generateFromStack: aNode on: aStream indent: anInteger - | idList | aNode args first isConstant ifFalse: [^self error: 'arg must be constant']. + pluginFunctionsUsed add: #stackValue:. idList := aNode args first value. (1 to: idList size) do: [:i | aStream nextPutAll: (idList at: i); + nextPutAll: ' = stackValue('; - nextPutAll: ' = interpreterProxy->stackValue('; nextPutAll: (idList size - i) asString; + nextPut: $)] - nextPutAll: ')'] separatedBy: [aStream nextPut: $;; crtab: anInteger]. ! Item was removed: - ----- Method: SmartSyntaxPluginCodeGenerator>>generateIsBytes:on:indent: (in category 'translating builtins') ----- - generateIsBytes: aNode on: aStream indent: anInteger - - aStream nextPutAll: 'interpreterProxy->isBytes('. - self emitCExpression: aNode receiver on: aStream. - aStream nextPutAll: ')'.! Item was changed: ----- Method: SmartSyntaxPluginCodeGenerator>>generateIsFloat:on:indent: (in category 'translating builtins') ----- generateIsFloat: aNode on: aStream indent: anInteger + self genCallOf: #isFloatObject: with: aNode receiver on: aStream! - - aStream nextPutAll: 'interpreterProxy->isFloatObject('. - self emitCExpression: aNode receiver on: aStream. - aStream nextPutAll: ')'.! Item was changed: ----- Method: SmartSyntaxPluginCodeGenerator>>generateIsIndexable:on:indent: (in category 'translating builtins') ----- generateIsIndexable: aNode on: aStream indent: anInteger + self genCallOf: #isIndexable: with: aNode receiver on: aStream! - - aStream nextPutAll: 'interpreterProxy->isIndexable('. - self emitCExpression: aNode receiver on: aStream. - aStream nextPutAll: ')'.! Item was removed: - ----- Method: SmartSyntaxPluginCodeGenerator>>generateIsInteger:on:indent: (in category 'translating builtins') ----- - generateIsInteger: aNode on: aStream indent: anInteger - - aStream nextPutAll: 'interpreterProxy->isIntegerValue('. - self emitCExpression: aNode receiver on: aStream. - aStream nextPutAll: ')'.! Item was changed: ----- Method: SmartSyntaxPluginCodeGenerator>>generateIsIntegerOop:on:indent: (in category 'translating builtins') ----- generateIsIntegerOop: aNode on: aStream indent: anInteger + self genCallOf: #isIntegerObject: with: aNode receiver on: aStream! - - aStream nextPutAll: 'interpreterProxy->isIntegerObject('. - self emitCExpression: aNode receiver on: aStream. - aStream nextPutAll: ')'.! Item was changed: ----- Method: SmartSyntaxPluginCodeGenerator>>generateIsIntegerValue:on:indent: (in category 'translating builtins') ----- generateIsIntegerValue: aNode on: aStream indent: anInteger + self genCallOf: #isIntegerValue: with: aNode receiver on: aStream! - - aStream nextPutAll: 'interpreterProxy->isIntegerValue('. - self emitCExpression: aNode receiver on: aStream. - aStream nextPutAll: ')'.! Item was changed: ----- Method: SmartSyntaxPluginCodeGenerator>>generateIsKindOf:on:indent: (in category 'translating builtins') ----- generateIsKindOf: aNode on: aStream indent: anInteger + self genCallOf: #is:KindOf: with: aNode receiver with: aNode args first on: aStream! - - aStream nextPutAll: 'interpreterProxy->isKindOf('. - self emitCExpression: aNode receiver on: aStream. - aStream nextPutAll: ','''. - self emitCExpression: aNode args first on: aStream. - aStream nextPutAll: ''')'.! Item was changed: ----- Method: SmartSyntaxPluginCodeGenerator>>generateIsMemberOf:on:indent: (in category 'translating builtins') ----- generateIsMemberOf: aNode on: aStream indent: anInteger + self genCallOf: #is:MemberOf: with: aNode receiver with: aNode args first on: aStream! - - aStream nextPutAll: 'interpreterProxy->isMemberOf('. - self emitCExpression: aNode receiver on: aStream. - aStream nextPutAll: ','''. - self emitCExpression: aNode args first on: aStream. - aStream nextPutAll: ''')'.! Item was changed: ----- Method: SmartSyntaxPluginCodeGenerator>>generateIsPointers:on:indent: (in category 'translating builtins') ----- generateIsPointers: aNode on: aStream indent: anInteger + self genCallOf: #isPointers: with: aNode receiver on: aStream! - - aStream nextPutAll: 'interpreterProxy->isPointers('. - self emitCExpression: aNode receiver on: aStream. - aStream nextPutAll: ')'.! Item was changed: ----- Method: SmartSyntaxPluginCodeGenerator>>generateIsWords:on:indent: (in category 'translating builtins') ----- generateIsWords: aNode on: aStream indent: anInteger + self genCallOf: #isWords: with: aNode receiver on: aStream! - - aStream nextPutAll: 'interpreterProxy->isWords('. - self emitCExpression: aNode receiver on: aStream. - aStream nextPutAll: ')'.! Item was changed: ----- Method: SmartSyntaxPluginCodeGenerator>>generateIsWordsOrBytes:on:indent: (in category 'translating builtins') ----- generateIsWordsOrBytes: aNode on: aStream indent: anInteger + self genCallOf: #isWordsOrBytes: with: aNode receiver on: aStream! - - aStream nextPutAll: 'interpreterProxy->isWordsOrBytes('. - self emitCExpression: aNode receiver on: aStream. - aStream nextPutAll: ')'.! Item was changed: ----- Method: SmartSyntaxPluginCodeGenerator>>generateRemapOopIn:on:indent: (in category 'translating builtins') ----- generateRemapOopIn: aNode on: aStream indent: level "Generate the C code for this message onto the given stream." | idList | + pluginFunctionsUsed add: #pushRemappableOop:; add: #popRemappableOop. idList := aNode args first nameOrValue. idList class == Array ifFalse: [idList := Array with: idList]. idList do: [:each | aStream + nextPutAll: 'pushRemappableOop('; - nextPutAll: 'interpreterProxy->pushRemappableOop('; nextPutAll: each asString; nextPutAll: ');'] separatedBy: [aStream crtab: level]. aStream cr. aNode args second emitCCodeOn: aStream level: level generator: self. level timesRepeat: [aStream tab]. idList reversed do: [:each | aStream nextPutAll: each asString; + nextPutAll: ' = popRemappableOop()'] - nextPutAll: ' = interpreterProxy->popRemappableOop()'] separatedBy: [aStream nextPut: $;; crtab: level].! Item was changed: ----- Method: SmartSyntaxPluginCodeGenerator>>generateStAt:on:indent: (in category 'translating builtins') ----- generateStAt: aNode on: aStream indent: anInteger + self genCallOf: #stObject:at: with: aNode receiver with: aNode args first on: aStream! - - aStream nextPutAll: 'interpreterProxy->stObjectat('. - self emitCExpression: aNode receiver on: aStream. - aStream nextPutAll: ','. - self emitCExpression: aNode args first on: aStream. - aStream nextPutAll: ')' - ! Item was changed: ----- Method: SmartSyntaxPluginCodeGenerator>>generateStAtPut:on:indent: (in category 'translating builtins') ----- generateStAtPut: aNode on: aStream indent: anInteger + self genCallOf: #stObject:at:put: + with: aNode receiver + with: aNode args first + with: aNode args second + on: aStream! - - aStream nextPutAll: 'interpreterProxy->stObjectatput('. - self emitCExpression: aNode receiver on: aStream. - aStream nextPutAll: ','. - self emitCExpression: aNode args first on: aStream. - aStream nextPutAll: ','. - self emitCExpression: aNode args second on: aStream. - aStream nextPutAll: ')' - ! Item was changed: ----- Method: SmartSyntaxPluginCodeGenerator>>generateStSize:on:indent: (in category 'translating builtins') ----- generateStSize: aNode on: aStream indent: anInteger + self genCallOf: #stSizeOf: with: aNode receiver on: aStream! - - aStream nextPutAll: 'interpreterProxy->stSizeOf('. - self emitCExpression: aNode receiver on: aStream. - aStream nextPutAll: ')'.! Item was changed: ----- Method: StackInterpreter>>getStackPointer (in category 'primitive support') ----- getStackPointer "For Alien FFI" <api> <returnTypeC: #'sqInt *'> + ^self cCoerce: stackPointer to: #'sqInt *'! - ^self cCoerceSimple: stackPointer to: #'sqInt *'! Item was changed: ----- Method: StackInterpreter>>stObject:at:put: (in category 'indexing primitive support') ----- stObject: array at: index put: value "Do what ST would return for <obj> at: index put: value." | hdr fmt totalLength fixedFields stSize | <inline: false> hdr := objectMemory baseHeader: array. fmt := objectMemory formatOfHeader: hdr. totalLength := objectMemory lengthOf: array baseHeader: hdr format: fmt. fixedFields := objectMemory fixedFieldsOf: array format: fmt length: totalLength. (fmt = 3 and: [objectMemory isContextHeader: hdr]) ifTrue: [stSize := self stackPointerForMaybeMarriedContext: array. ((self oop: index isGreaterThanOrEqualTo: 1) and: [(self oop: index isLessThanOrEqualTo: stSize) and: [self isStillMarriedContext: array]]) ifTrue: + [^self noInlineTemporary: index - 1 in: (self frameOfMarriedContext: array) put: value]] - [self noInlineTemporary: index - 1 in: (self frameOfMarriedContext: array) put: value. - ^self]] ifFalse: [stSize := totalLength - fixedFields]. ((self oop: index isGreaterThanOrEqualTo: (objectMemory firstValidIndexOfIndexableObject: array withFormat: fmt)) and: [self oop: index isLessThanOrEqualTo: stSize]) ifTrue: [self subscript: array with: (index + fixedFields) storing: value format: fmt] + ifFalse: [self primitiveFailFor: (fmt <= 1 ifTrue: [PrimErrBadReceiver] ifFalse: [PrimErrBadIndex])]. + ^value! - ifFalse: [self primitiveFailFor: (fmt <= 1 ifTrue: [PrimErrBadReceiver] ifFalse: [PrimErrBadIndex])]! Item was changed: ----- Method: TSendNode>>emitCCodeAsFunctionCallOn:level:generator: (in category 'C code generation') ----- emitCCodeAsFunctionCallOn: aStream level: level generator: aCodeGen "Translate this message send into a C function call" "Special case for pluggable modules. Replace messages to interpreterProxy by interpreterProxy->message(..) if the message is not builtin" (aCodeGen messageReceiverIsInterpreterProxy: self) ifTrue: + [(aCodeGen noteUsedPluginFunction: selector) ifTrue: + [aStream nextPutAll: 'interpreterProxy->']]. - [aStream nextPutAll: 'interpreterProxy->']. "Translate this message send into a C function call." aStream nextPutAll: (aCodeGen cFunctionNameFor: selector); nextPut: $(. "Only include the receiver as the first argument in certain cases. The receiver is always included if it is an expression. If it is a variable: If the vmClass says it is an implicit variable, don't include it. If the variable is 'self' and the method being called is not in the method set (i.e. it is some external code), don't include it." (self shouldExcludeReceiverAsFirstArgument: aCodeGen) ifFalse: [receiver emitCCodeOn: aStream level: level generator: aCodeGen. + arguments isEmpty ifFalse: - arguments isEmpty ifFalse: [aStream nextPutAll: ', ']]. arguments do: [ :arg| arg emitCCodeAsArgumentOn: aStream level: level generator: aCodeGen] separatedBy: [aStream nextPut: $,; space]. aStream nextPut: $)! Item was added: + TestCase subclass: #VMInterfaceConsistencyTests + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'VMMaker-Tests'! + + !VMInterfaceConsistencyTests commentStamp: 'eem 12/6/2012 15:03' prior: 0! + VMInterfaceConsistencyTests tests that the interpreter proxy implementations are consistent.! Item was added: + ----- Method: VMInterfaceConsistencyTests>>testInterpreterProxyInterface (in category 'tests') ----- + testInterpreterProxyInterface + "| fails | + fails := Set new. + [self new testInterpreterProxyInterface] + on: AssertionFailure, TestFailure + do: [:ex| + fails add: ex messageText. + ex resume]. + fails asArray sort do: + [:m| Transcript cr; nextPutAll: m; flush]" + (VMClass allSubclasses select: [:ea| (ea name endsWith: 'Interpreter') or: [ea name endsWith: 'InterpreterMT']]) do: + [:class| + self testInterpreterProxyInterfaceIsConsistentFor: class]! Item was added: + ----- Method: VMInterfaceConsistencyTests>>testInterpreterProxyInterfaceIsConsistentFor: (in category 'private-support') ----- + testInterpreterProxyInterfaceIsConsistentFor: aClass + | ccg | + ccg := VMPluginCodeGenerator new. + InterpreterProxy selectors asArray sort do: + [:sel| | pm | + ((#(initialize #'initialize-release' private) includes: (InterpreterProxy whichCategoryIncludesSelector: sel)) + or: [ccg noteUsedPluginFunction: sel]) ifFalse: + [pm := ccg compileToTMethodSelector: sel in: InterpreterProxy. + (aClass whichClassIncludesSelector: sel) ifNotNil: + [:impClass| | im pt it | + im := ccg compileToTMethodSelector: sel in: impClass. + "A number of functions are actually void in the interpreter but declared as sqInt in sqVirtualMachine.c, e.g. push" + self assert: ((pt := pm returnType) = (it := im returnType) + or: [pt = #sqInt and: [it = #void]]) + description: 'inconsistent returnType for ', sel, ' in InterpreterProxy vs ', impClass, ' ', pt, ' vs ', it. + pm args doWithIndex: + [:pma :i| | ima | + ima := im args at: i. + self assert: (pt := pm typeFor: pma in: ccg) = (it := im typeFor: ima in: ccg) + description: 'inconsistent ', i printString, (#('st' 'nd') at: i ifAbsent: 'th'), ' arg type for ', sel, ' in InterpreterProxy vs ', impClass, ' ', pt, ' vs ', it]]]]! Item was changed: CCodeGenerator subclass: #VMPluginCodeGenerator + instanceVariableNames: 'pluginClass pluginName pluginFunctionsUsed' - instanceVariableNames: 'pluginClass pluginName' classVariableNames: '' poolDictionaries: '' category: 'VMMaker-Translation to C'! !VMPluginCodeGenerator commentStamp: '<historical>' prior: 0! I generate code that can be loaded dynamically from external libraries (e.g., DSOs on Unix or DLLs on Windows)! Item was added: + ----- Method: VMPluginCodeGenerator>>emitCCodeOn:doInlining:doAssertions: (in category 'C code generator') ----- + emitCCodeOn: aStream doInlining: inlineFlag doAssertions: assertionFlag + "Generate twice; the first time to collect the used functions, the second to output the used functions." + [super emitCCodeOn: NullStream new doInlining: inlineFlag doAssertions: assertionFlag] + on: MessageNotUnderstood + do: [:ex| + (#(peekLast tab: crtab:) includes: ex message selector) ifTrue: + [ex resume: nil]. + ex pass]. + super emitCCodeOn: aStream doInlining: inlineFlag doAssertions: assertionFlag! Item was changed: ----- Method: VMPluginCodeGenerator>>emitCHeaderForPrimitivesOn: (in category 'C code generator') ----- emitCHeaderForPrimitivesOn: aStream "Write a C file header for compiled primitives onto the given stream." self emitCHeaderOn: aStream. aStream nextPutAll: ' /*** Proxy Functions ***/ + #if defined(SQUEAK_BUILTIN_PLUGIN) + extern sqInt stackValue(sqInt offset); + extern sqInt stackIntegerValue(sqInt offset); + extern sqInt failed(void); + # define successFlag (!!failed()) + extern sqInt success(sqInt aBoolean); + extern void * arrayValueOf(sqInt oop); + extern void * fetchArrayofObject(sqInt fieldIndex, sqInt objectPointer); + extern double fetchFloatofObject(sqInt fieldIndex, sqInt objectPointer); + extern sqInt fetchIntegerofObject(sqInt fieldIndex, sqInt objectPointer); + extern double floatValueOf(sqInt oop); + extern sqInt pop(sqInt nItems); + extern sqInt pushInteger(sqInt integerValue); + extern sqInt sizeOfSTArrayFromCPrimitive(void *cPtr); + extern sqInt storeIntegerofObjectwithValue(sqInt index, sqInt oop, sqInt integer); + extern sqInt primitiveFail(void); + #else /* SQUEAK_BUILTIN_PLUGIN */ + # define stackValue(i) (interpreterProxy->stackValue(i)) + # define stackIntegerValue(i) (interpreterProxy->stackIntegerValue(i)) + # define successFlag (!!interpreterProxy->failed()) + # define success(bool) (interpreterProxy->success(bool)) + # define arrayValueOf(oop) (interpreterProxy->arrayValueOf(oop)) + # define fetchArrayofObject(idx,oop) (interpreterProxy->fetchArrayofObject(idx,oop)) + # define fetchFloatofObject(idx,oop) (interpreterProxy->fetchFloatofObject(idx,oop)) + # define fetchIntegerofObject(idx,oop) (interpreterProxy->fetchIntegerofObject(idx,oop)) + # define floatValueOf(oop) (interpreterProxy->floatValueOf(oop)) + # define pop(n) (interpreterProxy->pop(n)) + # define pushInteger(n) (interpreterProxy->pushInteger(n)) + # define sizeOfSTArrayFromCPrimitive(cPtr) (interpreterProxy->sizeOfSTArrayFromCPrimitive(cPtr)) + # define storeIntegerofObjectwithValue(idx,oop,value) (interpreterProxy->storeIntegerofObjectwithValue(idx,oop,value)) + # define primitiveFail() interpreterProxy->primitiveFail() + #endif /* SQUEAK_BUILTIN_PLUGIN */ + - #define stackValue(i) (interpreterProxy->stackValue(i)) - #define stackIntegerValue(i) (interpreterProxy->stackIntegerValue(i)) - #define successFlag (!!interpreterProxy->failed()) - #define success(bool) (interpreterProxy->success(bool)) - #define arrayValueOf(oop) (interpreterProxy->arrayValueOf(oop)) - #define checkedIntegerValueOf(oop) (interpreterProxy->checkedIntegerValueOf(oop)) - #define fetchArrayofObject(idx,oop) (interpreterProxy->fetchArrayofObject(idx,oop)) - #define fetchFloatofObject(idx,oop) (interpreterProxy->fetchFloatofObject(idx,oop)) - #define fetchIntegerofObject(idx,oop) (interpreterProxy->fetchIntegerofObject(idx,oop)) - #define floatValueOf(oop) (interpreterProxy->floatValueOf(oop)) - #define pop(n) (interpreterProxy->pop(n)) - #define pushInteger(n) (interpreterProxy->pushInteger(n)) - #define sizeOfSTArrayFromCPrimitive(cPtr) (interpreterProxy->sizeOfSTArrayFromCPrimitive(cPtr)) - #define storeIntegerofObjectwithValue(idx,oop,value) (interpreterProxy->storeIntegerofObjectwithValue(idx,oop,value)) - #define primitiveFail() interpreterProxy->primitiveFail() /* allows accessing Strings in both C and Smalltalk */ #define asciiValue(c) c + + '! - '. - aStream cr.! Item was added: + ----- Method: VMPluginCodeGenerator>>generateInterpreterProxyFunctionDeference:on:indent: (in category 'C translation') ----- + generateInterpreterProxyFunctionDeference: aNode on: aStream indent: anInteger + | pluginsToClone | + (pluginsToClone := self pluginFunctionsToClone) isEmpty ifTrue: + [^self]. + aStream cr; nextPutAll: '#if !!defined(SQUEAK_BUILTIN_PLUGIN)'. + pluginsToClone do: + [:s| | cs | + cs := self cFunctionNameFor: s. + aStream crtab: anInteger; nextPutAll: cs; nextPutAll: ' = interpreterProxy->'; nextPutAll: cs; nextPut: $;]. + aStream cr; nextPutAll: '#endif /* !!defined(SQUEAK_BUILTIN_PLUGIN) */'.! Item was added: + ----- Method: VMPluginCodeGenerator>>initialize (in category 'public') ----- + initialize + super initialize. + pluginFunctionsUsed := Set new! Item was added: + ----- Method: VMPluginCodeGenerator>>initializeCTranslationDictionary (in category 'public') ----- + initializeCTranslationDictionary + "Initialize the dictionary mapping message names to actions for C code generation." + + super initializeCTranslationDictionary. + translationDict + at: #expandDereferenceInterpreterProxyFunctionTable + put: #generateInterpreterProxyFunctionDeference:on:indent:! Item was added: + ----- Method: VMPluginCodeGenerator>>noteUsedPluginFunction: (in category 'public') ----- + noteUsedPluginFunction: aSelector + "Remember aSelector and answer whether the call should be made through + interpreterProxy. If not, it will be made either directly (in an internal plugin) + or through a local copy of the function pointer (in an external plugin)." + pluginFunctionsUsed add: aSelector. + "These two are static to sqVirtualMachine.c and so + they must be called through the interpreterProxy." + ^#(majorVersion minorVersion) includes: aSelector! Item was added: + ----- Method: VMPluginCodeGenerator>>pluginFunctionsToClone (in category 'public') ----- + pluginFunctionsToClone + "Answer those of the used plugin functions to clone as a sorted collection. + Exclude those that are static to sqVirtualMachine.c and hence always need + to be called through interpreterProxy." + + ^(pluginFunctionsUsed reject: + [:selector| self noteUsedPluginFunction: selector]) + asSortedCollection! Item was added: + ----- Method: VMPluginCodeGenerator>>preDeclareInterpreterProxyOn: (in category 'C code generator') ----- + preDeclareInterpreterProxyOn: aStream + "Put the necessary #defines needed before interpreterProxy. Basically + internal plugins use the VM's interpreterProxy variable and external plugins + use their own. Override to keep local copies of all functions in external + prims, and link directly in internal plugins." + | pluginsToClone | + (pluginsToClone := self pluginFunctionsToClone) isEmpty ifTrue: + [^super preDeclareInterpreterProxyOn: aStream]. + aStream cr; nextPutAll: '#if !!defined(SQUEAK_BUILTIN_PLUGIN)'; cr. + pluginsToClone do: + [:selector| | functionName | + functionName := self cFunctionNameFor: selector. + aStream nextPutAll: + ((String streamContents: + [:s| + (self compileToTMethodSelector: selector in: InterpreterProxy) + emitCFunctionPrototype: s generator: self]) + copyReplaceAll: functionName + with: '(*', functionName, ')'). + aStream nextPut: $;; cr]. + aStream nextPutAll: '#else /* !!defined(SQUEAK_BUILTIN_PLUGIN) */'; cr. + pluginsToClone do: + [:selector| + aStream nextPutAll: 'extern '. + (self compileToTMethodSelector: selector in: InterpreterProxy) + static: false; + emitCFunctionPrototype: aStream generator: self. + aStream nextPut: $;; cr]. + aStream cr; nextPutAll: 'extern'. + aStream cr; nextPutAll: '#endif'; cr!

1 0

VM Maker: VMMaker-eem.291.mcz
by commits＠source.squeak.org 11 Dec '12

11 Dec '12

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker-eem.291.mcz ==================== Summary ==================== Name: VMMaker-eem.291 Author: eem Time: 11 December 2012, 1:27:23.704 pm UUID: 1b5cd88a-d31b-4b1e-8dca-1a0e548a8310 Ancestors: VMMaker-dtl.290 Fix receiver of a remapOop:in: send in LargeIntegersPlugin. Replace _'s with :='s in the ImmX11Plugin (so it can load into trunk without fooling with settings) and categorize. =============== Diff against VMMaker-dtl.290 =============== Item was changed: + ----- Method: ImmX11Plugin>>initialiseModule (in category 'initialize-release') ----- - ----- Method: ImmX11Plugin>>initialiseModule (in category 'as yet unclassified') ----- initialiseModule <export: true> ^ true ! Item was changed: + ----- Method: ImmX11Plugin>>primGetEncoding (in category 'primitives') ----- - ----- Method: ImmX11Plugin>>primGetEncoding (in category 'as yet unclassified') ----- primGetEncoding | ret array len | <export: true> <var: #len type: 'int'> <var: #array type: 'char *'> len := self cCode: 'strlen(sqTextEncoding)'. ret := interpreterProxy instantiateClass: interpreterProxy classString indexableSize: len. array := self cCoerce: (interpreterProxy firstIndexableField: ret) to: 'char *'. self cCode: 'strncpy(array, (char *)sqTextEncoding, len)'. ^ ret.! Item was changed: + ----- Method: ImmX11Plugin>>primGetLocale (in category 'primitives') ----- - ----- Method: ImmX11Plugin>>primGetLocale (in category 'as yet unclassified') ----- primGetLocale | ret array len locale | <export: true> <var: #len type: 'int'> <var: #array type: 'char *'> <var: #locale type: 'char *'> + locale := self cCode: 'setlocale(LC_CTYPE, "")'. - locale _ self cCode: 'setlocale(LC_CTYPE, "")'. (self cCode: 'locale') + ifFalse: [ ret := interpreterProxy nilObject ] - ifFalse: [ ret _ interpreterProxy nilObject ] ifTrue: [ + len := self cCode: 'strlen(locale)'. + ret := interpreterProxy - len _ self cCode: 'strlen(locale)'. - ret _ interpreterProxy instantiateClass: interpreterProxy classString indexableSize: len. + array := self cCoerce: (interpreterProxy firstIndexableField: ret) to: 'char *'. - array _ self cCoerce: (interpreterProxy firstIndexableField: ret) to: 'char *'. self cCode: 'strncpy(array, (char *)locale, len)'. ]. ^ ret.! Item was changed: + ----- Method: ImmX11Plugin>>primGetLocaleEncoding (in category 'primitives') ----- - ----- Method: ImmX11Plugin>>primGetLocaleEncoding (in category 'as yet unclassified') ----- primGetLocaleEncoding | ret array len | <export: true> <var: #len type: 'int'> <var: #array type: 'char *'> (self cCode: '(int) localeEncoding') ifFalse: [ ret := interpreterProxy nilObject ] ifTrue: [ len := self cCode: 'strlen(localeEncoding)'. ret := interpreterProxy instantiateClass: interpreterProxy classString indexableSize: len. array := self cCoerce: (interpreterProxy firstIndexableField: ret) to: 'char *'. self cCode: 'strncpy(array, (char *)localeEncoding, len)'. ]. ^ ret.! Item was changed: + ----- Method: ImmX11Plugin>>primGetPathEnc (in category 'primitives') ----- - ----- Method: ImmX11Plugin>>primGetPathEnc (in category 'as yet unclassified') ----- primGetPathEnc | ret array len | <export: true> <var: #len type: 'int'> <var: #array type: 'char *'> len := self cCode: 'strlen(uxPathEncoding)'. ret := interpreterProxy instantiateClass: interpreterProxy classString indexableSize: len. array := self cCoerce: (interpreterProxy firstIndexableField: ret) to: 'char *'. self cCode: 'strncpy(array, (char *)uxPathEncoding, len)'. ^ ret.! Item was changed: + ----- Method: ImmX11Plugin>>primGetTextEnc (in category 'primitives') ----- - ----- Method: ImmX11Plugin>>primGetTextEnc (in category 'as yet unclassified') ----- primGetTextEnc | ret array len | <export: true> <var: #len type: 'int'> <var: #array type: 'char *'> len := self cCode: 'strlen(uxTextEncoding)'. ret := interpreterProxy instantiateClass: interpreterProxy classString indexableSize: len. array := self cCoerce: (interpreterProxy firstIndexableField: ret) to: 'char *'. self cCode: 'strncpy(array, (char *)uxTextEncoding, len)'. ^ ret.! Item was changed: + ----- Method: ImmX11Plugin>>primGetXWinEnc (in category 'primitives') ----- - ----- Method: ImmX11Plugin>>primGetXWinEnc (in category 'as yet unclassified') ----- primGetXWinEnc | ret array len | <export: true> <var: #len type: 'int'> <var: #array type: 'char *'> len := self cCode: 'strlen(uxXWinEncoding)'. ret := interpreterProxy instantiateClass: interpreterProxy classString indexableSize: len. array := self cCoerce: (interpreterProxy firstIndexableField: ret) to: 'char *'. self cCode: 'strncpy(array, (char *)uxXWinEncoding, len)'. ^ ret.! Item was changed: + ----- Method: ImmX11Plugin>>primIsTextEncUTF8 (in category 'primitives') ----- - ----- Method: ImmX11Plugin>>primIsTextEncUTF8 (in category 'as yet unclassified') ----- primIsTextEncUTF8 <export: true> self primitive: 'primIsTextEncUTF8'. ^ (self cCode: 'textEncodingUTF8') asOop: Boolean.! Item was changed: + ----- Method: ImmX11Plugin>>primSetCompositionFocus: (in category 'primitives') ----- - ----- Method: ImmX11Plugin>>primSetCompositionFocus: (in category 'as yet unclassified') ----- primSetCompositionFocus: bool | ret | <export: true> self primitive: 'primSetCompositionFocus' parameters: #(Boolean). ret := self cCode: 'setCompositionFocus(bool)'. ret = false ifTrue: [ interpreterProxy primitiveFail. ^ nil ]. ^ ret asOop: Boolean ! Item was changed: + ----- Method: ImmX11Plugin>>primSetCompositionWindowPositionX:y: (in category 'primitives') ----- - ----- Method: ImmX11Plugin>>primSetCompositionWindowPositionX:y: (in category 'as yet unclassified') ----- primSetCompositionWindowPositionX: x y: y | ret | <export: true> self primitive: 'primSetCompositionWindowPosition' parameters: #(SmallInteger SmallInteger). ret := self cCode: 'setCompositionWindowPosition(x, y)'. ret = false ifTrue: [ interpreterProxy primitiveFail. ^ nil ]. ^ ret asOop: Boolean ! Item was changed: + ----- Method: ImmX11Plugin>>primSetEncoding: (in category 'primitives') ----- - ----- Method: ImmX11Plugin>>primSetEncoding: (in category 'as yet unclassified') ----- primSetEncoding: encoding | name len | <export: true> <var: #name type: 'char *'> <var: #len type: 'size_t'> + len := interpreterProxy stSizeOf: encoding. + name := self cCoerce: (interpreterProxy firstIndexableField: encoding) to: 'char *'. - len _ interpreterProxy stSizeOf: encoding. - name _ self cCoerce: (interpreterProxy firstIndexableField: encoding) to: 'char *'. self cCode: 'setNEncoding(&sqTextEncoding, name, len)'. ^ encoding. ! Item was changed: + ----- Method: ImmX11Plugin>>primSetEncodingToLocale (in category 'primitives') ----- - ----- Method: ImmX11Plugin>>primSetEncodingToLocale (in category 'as yet unclassified') ----- primSetEncodingToLocale | ret | <export: true> self primitive: 'primSetEncodingToLocale'. (self cCode: '(int) localeEncoding') ifFalse: [ ret := interpreterProxy falseObject ] ifTrue: [ self cCode: 'sqTextEncoding = (void *)localeEncoding'. ret := interpreterProxy trueObject ]. ^ ret! Item was changed: + ----- Method: ImmX11Plugin>>primSetLocale: (in category 'primitives') ----- - ----- Method: ImmX11Plugin>>primSetLocale: (in category 'as yet unclassified') ----- primSetLocale: locale | name len ret array | <export: true> <var: #name type: 'char *'> <var: #array type: 'char *'> <var: #len type: 'size_t'> + len := interpreterProxy stSizeOf: locale. + name := self cCoerce: (interpreterProxy arrayValueOf: locale) to: 'char *'. + name := self cCode: 'setLocale(name, len)'. - len _ interpreterProxy stSizeOf: locale. - name _ self cCoerce: (interpreterProxy arrayValueOf: locale) to: 'char *'. - name _ self cCode: 'setLocale(name, len)'. (self cCode: '(int) name') ifFalse: [^ interpreterProxy nilObject ] ifTrue: [ + len := self cCode: 'strlen(name)'. + ret := interpreterProxy - len _ self cCode: 'strlen(name)'. - ret _ interpreterProxy instantiateClass: interpreterProxy classString indexableSize: len. + array := self cCoerce: (interpreterProxy firstIndexableField: ret) to: 'char *'. - array _ self cCoerce: (interpreterProxy firstIndexableField: ret) to: 'char *'. self cCode: 'strncpy(array, (char *)name, len)'. ^ ret ]. ! Item was changed: + ----- Method: ImmX11Plugin>>primSetLocaleEncoding: (in category 'primitives') ----- - ----- Method: ImmX11Plugin>>primSetLocaleEncoding: (in category 'as yet unclassified') ----- primSetLocaleEncoding: encoding | name len | <export: true> <var: #name type: 'char *'> <var: #len type: 'size_t'> + len := interpreterProxy stSizeOf: encoding. + name := self cCoerce: (interpreterProxy firstIndexableField: encoding) to: 'char *'. - len _ interpreterProxy stSizeOf: encoding. - name _ self cCoerce: (interpreterProxy firstIndexableField: encoding) to: 'char *'. self cCode: 'setNEncoding(&localeEncoding, name, len)'. self cCode: 'sqTextEncoding= uxTextEncoding= uxPathEncoding= uxXWinEncoding= localeEncoding'. ^ encoding. ! Item was changed: + ----- Method: ImmX11Plugin>>primSetPathEnc: (in category 'primitives') ----- - ----- Method: ImmX11Plugin>>primSetPathEnc: (in category 'as yet unclassified') ----- primSetPathEnc: encoding | name len | <export: true> <var: #name type: 'char *'> <var: #len type: 'size_t'> + len := interpreterProxy stSizeOf: encoding. + name := self cCoerce: (interpreterProxy firstIndexableField: encoding) to: 'char *'. - len _ interpreterProxy stSizeOf: encoding. - name _ self cCoerce: (interpreterProxy firstIndexableField: encoding) to: 'char *'. self cCode: 'setNEncoding(&uxPathEncoding, name, len)'. ^ encoding.! Item was changed: + ----- Method: ImmX11Plugin>>primSetPathEncToLocale (in category 'primitives') ----- - ----- Method: ImmX11Plugin>>primSetPathEncToLocale (in category 'as yet unclassified') ----- primSetPathEncToLocale | ret | <export: true> self primitive: 'primSetPathEncToLocale'. (self cCode: '(int) localeEncoding') ifFalse: [ ret := interpreterProxy falseObject ] ifTrue: [ self cCode: 'uxPathEncoding = (void *)localeEncoding'. ret := interpreterProxy trueObject ]. ^ ret! Item was changed: + ----- Method: ImmX11Plugin>>primSetTextEnc: (in category 'primitives') ----- - ----- Method: ImmX11Plugin>>primSetTextEnc: (in category 'as yet unclassified') ----- primSetTextEnc: encoding | name len | <export: true> <var: #name type: 'char *'> <var: #len type: 'size_t'> + len := interpreterProxy stSizeOf: encoding. + name := self cCoerce: (interpreterProxy firstIndexableField: encoding) to: 'char *'. - len _ interpreterProxy stSizeOf: encoding. - name _ self cCoerce: (interpreterProxy firstIndexableField: encoding) to: 'char *'. self cCode: 'setNEncoding(&uxTextEncoding, name, len)'. ^ encoding.! Item was changed: + ----- Method: ImmX11Plugin>>primSetTextEncToLocale (in category 'primitives') ----- - ----- Method: ImmX11Plugin>>primSetTextEncToLocale (in category 'as yet unclassified') ----- primSetTextEncToLocale | ret | <export: true> self primitive: 'primSetTextEncToLocale'. (self cCode: '(int) localeEncoding') ifFalse: [ ret := interpreterProxy falseObject ] ifTrue: [ self cCode: 'uxTextEncoding = (void *)localeEncoding'. ret := interpreterProxy trueObject ]. ^ ret! Item was changed: + ----- Method: ImmX11Plugin>>primSetTextEncUTF8: (in category 'primitives') ----- - ----- Method: ImmX11Plugin>>primSetTextEncUTF8: (in category 'as yet unclassified') ----- primSetTextEncUTF8: bool <export: true> self primitive: 'primSetTextEncUTF8' parameters: #(Boolean). self cCode: 'textEncodingUTF8 = bool'. ^ bool asOop: Boolean.! Item was changed: + ----- Method: ImmX11Plugin>>primSetXWinEnc: (in category 'primitives') ----- - ----- Method: ImmX11Plugin>>primSetXWinEnc: (in category 'as yet unclassified') ----- primSetXWinEnc: encoding | name len | <export: true> <var: #name type: 'char *'> <var: #len type: 'size_t'> + len := interpreterProxy stSizeOf: encoding. + name := self cCoerce: (interpreterProxy firstIndexableField: encoding) to: 'char *'. - len _ interpreterProxy stSizeOf: encoding. - name _ self cCoerce: (interpreterProxy firstIndexableField: encoding) to: 'char *'. self cCode: 'setNEncoding(&uxXWinEncoding, name, len)'. ^ encoding.! Item was changed: + ----- Method: ImmX11Plugin>>primSetXWinEncToLocale (in category 'primitives') ----- - ----- Method: ImmX11Plugin>>primSetXWinEncToLocale (in category 'as yet unclassified') ----- primSetXWinEncToLocale | ret | <export: true> self primitive: 'primSetXWinEncToLocale'. (self cCode: '(int) localeEncoding') ifFalse: [ ret := interpreterProxy falseObject ] ifTrue: [ self cCode: 'uxXWinEncoding = (void *)localeEncoding'. ret := interpreterProxy trueObject ]. ^ ret! Item was changed: + ----- Method: ImmX11Plugin>>shutdownModule (in category 'initialize-release') ----- - ----- Method: ImmX11Plugin>>shutdownModule (in category 'as yet unclassified') ----- shutdownModule <export: true> ^ true ! Item was changed: ----- Method: LargeIntegersPlugin>>digitAddLarge:with: (in category 'oop functions') ----- digitAddLarge: firstInteger with: secondInteger "Does not need to normalize!!" | over firstLen secondLen shortInt shortLen longInt longLen sum newSum resClass | <var: #over type: 'unsigned char '> firstLen := self byteSizeOfBytes: firstInteger. secondLen := self byteSizeOfBytes: secondInteger. resClass := interpreterProxy fetchClassOf: firstInteger. firstLen <= secondLen ifTrue: [shortInt := firstInteger. shortLen := firstLen. longInt := secondInteger. longLen := secondLen] ifFalse: [shortInt := secondInteger. shortLen := secondLen. longInt := firstInteger. longLen := firstLen]. " sum := Integer new: len neg: firstInteger negative." self remapOop: #(shortInt longInt ) in: [sum := interpreterProxy instantiateClass: resClass indexableSize: longLen]. over := self cDigitAdd: (interpreterProxy firstIndexableField: shortInt) len: shortLen with: (interpreterProxy firstIndexableField: longInt) len: longLen into: (interpreterProxy firstIndexableField: sum). over > 0 ifTrue: ["sum := sum growby: 1." + self remapOop: sum in: [newSum := interpreterProxy instantiateClass: resClass indexableSize: longLen + 1]. - interpreterProxy remapOop: sum in: [newSum := interpreterProxy instantiateClass: resClass indexableSize: longLen + 1]. self cBytesCopyFrom: (interpreterProxy firstIndexableField: sum) to: (interpreterProxy firstIndexableField: newSum) len: longLen. sum := newSum. "C index!!" (self cCoerce: (interpreterProxy firstIndexableField: sum) to: 'unsigned char *') at: longLen put: over]. ^ sum!

1 0

VM Maker: VMMaker-oscog-EstebanLorenzano.228.mcz
by David T. Lewis 11 Dec '12

11 Dec '12

Commit notice blocked due to size, forwarding trimmed version: ----- Forwarded message from vm-dev-owner(a)lists.squeakfoundation.org ----- Delivered-To: list-vm-dev(a)lists.squeakfoundation.org Date: Tue, 11 Dec 2012 13:31:12.126 0000 From: commits(a)source.squeak.org To: vm-dev(a)lists.squeakfoundation.org Reply-To: vm-dev(a)lists.squeakfoundation.org Subject: VM Maker: VMMaker-oscog-EstebanLorenzano.228.mcz Esteban Lorenzano uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker-oscog-EstebanLorenzano.228.mcz ==================== Summary ==================== Name: VMMaker-oscog-EstebanLorenzano.228 Author: EstebanLorenzano Time: 11 December 2012, 2:30:45.751 pm UUID: a2751bbe-713b-4ed3-94e3-4cd469f13f43 Ancestors: VMMaker-oscog-EstebanLorenzano.166, VMMaker.oscog-eem.227 - merged with Eliot 227 version =============== Diff against VMMaker-oscog-EstebanLorenzano.166 =============== Item was changed: ----- Method: AbstractInstructionTests>>runAddCqR: (in category 'running') ----- runAddCqR: assertPrintBar "self defaultTester runAddCqR: true" "self defaultTester runAddCqR: false" | memory | + memory := ByteArray new: 20. - memory := ByteArray new: 16. self concreteCompilerClass dataRegistersWithAccessorsDo: [:reg :rgetter :rsetter| <snip>

2 1

VM Maker: CMakeVMMaker-EstebanLorenzano.188.mcz
by commits＠source.squeak.org 11 Dec '12

11 Dec '12

Esteban Lorenzano uploaded a new version of CMakeVMMaker to project VM Maker: http://source.squeak.org/VMMaker/CMakeVMMaker-EstebanLorenzano.188.mcz ==================== Summary ==================== Name: CMakeVMMaker-EstebanLorenzano.188 Author: EstebanLorenzano Time: 11 December 2012, 2:25:16.738 pm UUID: f69f1b33-47e1-439a-a51c-c16821cfeaa8 Ancestors: CMakeVMMaker-EstebanLorenzano.187 - small fix =============== Diff against CMakeVMMaker-EstebanLorenzano.187 =============== Item was changed: ----- Method: CPlatformConfig>>generateSources (in category 'source generation') ----- generateSources "Generate whole VM + plugins sources" | maker | self validateSourcesPresent. self prepareForGeneration. "suppress questions and deprecation warnings during generation " [[ maker := self prepareVMMaker. maker interpreterClass: self interpreterClass. self cogitClass ifNotNil: [:cg | maker cogitClass: cg. "this is ugly, before VMMaker will be fixed to initialize stuff properly" + Cogit initializeCompilationWithConstantsOptions: Dictionary new. - Cogit initializeCompilationConstants. cg initializeWithOptions: (maker instVarNamed: 'optionsDictionary') ]. maker generateEntire ] on: ProvideAnswerNotification do: [:ex | ex resume: true ]] on: Deprecation do: [:ex | ex resume ]. ! Item was changed: ----- Method: CogFamilyCocoaIOSConfig>>setGlobalOptions: (in category 'settings') ----- setGlobalOptions: maker "set any CMake global options, before declaring a project in cmake file" maker set: 'CMAKE_C_COMPILER' to: '/usr/bin/gcc'. maker set: 'CMAKE_CXX_COMPILER' to: '/usr/bin/g++'. maker set: 'CMAKE_OSX_ARCHITECTURES' to: 'i386'. maker set: 'CMAKE_OSX_SYSROOT' to: '/'. "maker set: 'CMAKE_OSX_SYSROOT' to: '/Applications/Xcode.app/Contents/Developer/Platforms/MacOSX.platform/Developer/SDKs/MacOSX10.8.sdk'"!

1 0

Where does process preemtion takes place?
by Guillermo Polito 10 Dec '12

10 Dec '12

Hi! I was looking at the process machinery in VMMaker and I can't find where the preemption of processes takes place... Can someone point me a place? Tx, Guille

2 6

VM Maker: ImageFormat-dtl.16.mcz
by commits＠source.squeak.org 09 Dec '12

09 Dec '12

David T. Lewis uploaded a new version of ImageFormat to project VM Maker: http://source.squeak.org/VMMaker/ImageFormat-dtl.16.mcz ==================== Summary ==================== Name: ImageFormat-dtl.16 Author: dtl Time: 8 December 2012, 8:38:44.785 pm UUID: 1cad9e33-6534-4140-8730-c316e5291e90 Ancestors: ImageFormat-dtl.15 Add a newline to the output of the ckformat program to make it useful as a command line utility, with no impact on shell scripts that use it. Also fix horribly named methods. =============== Diff against ImageFormat-dtl.15 =============== Item was added: + ----- Method: ImageFormat class>>createCkFormatProgram (in category 'ckformat') ----- + createCkFormatProgram + "Create ckformat source file in the default directory" + + "ImageFormat createCkFormatProgram" + + ^self storeCkFormatOnFile: 'ckformat.c' ! Item was removed: - ----- Method: ImageFormat class>>createCkStatusProgram (in category 'ckformat') ----- - createCkStatusProgram - "Create ckformat source file in the default directory" - - "ImageFormat createCkStatusProgram" - - ^self storeCkstatusOnFile: 'ckformat.c' ! Item was added: + ----- Method: ImageFormat class>>generateCkFormatProgram:on: (in category 'ckformat') ----- + generateCkFormatProgram: programName on: stream + "Generate source code for an image format version reader. The program + is intended for testing image file format from a unix shell script such that + the shell script can decide what VM to run based on image requirements." + + | formatNumber | + stream nextPutAll: '/* ', programName, ': Print the image format number on standard output */'; cr; + nextPutAll: '/* for use in a shell script to test image format requirements. */'; cr; + nextPutAll: '/* A non-zero return status code indicates failure. */'; cr; cr; + nextPutAll: '/* Usage: ', programName, ' imageFileName */'; cr; cr; + nextPutAll: '/* --- DO NOT EDIT THIS FILE --- */'; cr; + nextPutAll: '/* --- Automatically generated from class ', self name, ' ', DateAndTime now asString, '--- */'; cr; + nextPutAll: '/* --- Source code is in package ImageFormat in the VMMaker repository --- */'; cr; + nextPutAll: '/* --- DO NOT EDIT THIS FILE --- */'; cr; cr; + nextPutAll: '#include <stdio.h>'; cr; + nextPutAll: '#include <stdlib.h>'; cr; + nextPutAll: '#include <string.h>'; cr; cr; + nextPutAll: 'main(int argc, char **argv) {'; cr; + tab; nextPutAll: 'FILE *f;'; cr; + tab; nextPutAll: 'unsigned char buf[8];'; cr; + tab; nextPutAll: 'int formatNumber;'; cr; + tab; nextPutAll: 'unsigned char c;'; cr; + tab; nextPutAll: 'int match;'; cr; + tab; nextPutAll: 'if (argc !!= 2) {'; cr; + tab; tab; nextPutAll: 'printf("usage: ', programName, ' imageFileName\n");'; cr; + tab; tab; nextPutAll: 'exit(1);'; cr; + tab; nextPutAll: '}'; cr; + tab; nextPutAll: 'f = fopen(argv[1], "r");'; cr; + tab; nextPutAll: 'if (f == NULL) {'; cr; + tab; tab; nextPutAll: 'perror(argv[1]);'; cr; + tab; tab; nextPutAll: 'exit(2);'; cr; + tab; nextPutAll: '}'; cr. + { 0. 512 } do: [:offset | + stream + tab; nextPutAll: 'if(fseek(f, '; nextPutAll: offset asString; nextPutAll: 'L, SEEK_SET) !!= 0) {';cr; + tab; tab; nextPutAll: 'fprintf(stderr, "cannot go to pos %d in %s\n", '; nextPutAll: offset asString; nextPutAll: ', argv[1]);'; cr; + tab; tab; nextPutAll: 'exit(3);'; cr; + tab; nextPutAll: '}'; cr; + tab; nextPutAll: 'if (fread(buf, 1, 8, f) < 8) {'; cr; + tab; tab; nextPutAll: 'fprintf(stderr, "cannot read %s\n", argv[1]);'; cr; + tab; tab; nextPutAll: 'exit(3);'; cr; + tab; nextPutAll: '}'; cr. + self versionNumberByteArrays withIndexDo: [ :v :tag | | b | + formatNumber := (self fromBytes: v) asInteger. + b := 'b_', formatNumber asString, '_', tag asString. + stream tab; nextPutAll: '{'; cr; tab; nextPutAll: 'unsigned char ', b, '[', v size asString, ']= { '. + v inject: true into: [:first : elem | + first ifFalse: [stream nextPutAll: ', ']. + stream nextPutAll: elem asString. + false]. + stream nextPutAll: '};'; cr; + tab; nextPutAll: 'if (strncmp(buf, ', b, ', ', v size asString, ') == 0) {'; cr; + tab; tab; nextPutAll: 'printf("%d\n", ', formatNumber, ');'; cr; + tab; tab; nextPutAll: 'exit(0);'; cr; + tab; nextPutAll: '}'; cr; tab; nextPutAll: '}'; cr]]. + stream tab; nextPutAll: 'printf("0\n"); /* print an invalid format number */';cr; + tab; nextPutAll: 'exit (-1); /* not found, exit with error code */'; cr; + nextPutAll: '}'; cr + ! Item was removed: - ----- Method: ImageFormat class>>generateCkStatusProgram:on: (in category 'ckformat') ----- - generateCkStatusProgram: programName on: stream - "Generate source code for an image format version reader. The program - is intended for testing image file format from a unix shell script such that - the shell script can decide what VM to run based on image requirements." - - | formatNumber | - stream nextPutAll: '/* ', programName, ': Print the image format number on standard output */'; cr; - nextPutAll: '/* for use in a shell script to test image format requirements. */'; cr; - nextPutAll: '/* A non-zero return status code indicates failure. */'; cr; cr; - nextPutAll: '/* Usage: ', programName, ' imageFileName */'; cr; cr; - nextPutAll: '/* --- DO NOT EDIT THIS FILE --- */'; cr; - nextPutAll: '/* --- Automatically generated from class ', self name, ' ', DateAndTime now asString, '--- */'; cr; - nextPutAll: '/* --- Source code is in package ImageFormat in the VMMaker repository --- */'; cr; - nextPutAll: '/* --- DO NOT EDIT THIS FILE --- */'; cr; cr; - nextPutAll: '#include <stdio.h>'; cr; - nextPutAll: '#include <stdlib.h>'; cr; - nextPutAll: '#include <string.h>'; cr; cr; - nextPutAll: 'main(int argc, char **argv) {'; cr; - tab; nextPutAll: 'FILE *f;'; cr; - tab; nextPutAll: 'unsigned char buf[8];'; cr; - tab; nextPutAll: 'int formatNumber;'; cr; - tab; nextPutAll: 'unsigned char c;'; cr; - tab; nextPutAll: 'int match;'; cr; - tab; nextPutAll: 'if (argc !!= 2) {'; cr; - tab; tab; nextPutAll: 'printf("usage: ', programName, ' imageFileName\n");'; cr; - tab; tab; nextPutAll: 'exit(1);'; cr; - tab; nextPutAll: '}'; cr; - tab; nextPutAll: 'f = fopen(argv[1], "r");'; cr; - tab; nextPutAll: 'if (f == NULL) {'; cr; - tab; tab; nextPutAll: 'perror(argv[1]);'; cr; - tab; tab; nextPutAll: 'exit(2);'; cr; - tab; nextPutAll: '}'; cr. - { 0. 512 } do: [:offset | - stream - tab; nextPutAll: 'if(fseek(f, '; nextPutAll: offset asString; nextPutAll: 'L, SEEK_SET) !!= 0) {';cr; - tab; tab; nextPutAll: 'fprintf(stderr, "cannot go to pos %d in %s\n", '; nextPutAll: offset asString; nextPutAll: ', argv[1]);'; cr; - tab; tab; nextPutAll: 'exit(3);'; cr; - tab; nextPutAll: '}'; cr; - tab; nextPutAll: 'if (fread(buf, 1, 8, f) < 8) {'; cr; - tab; tab; nextPutAll: 'fprintf(stderr, "cannot read %s\n", argv[1]);'; cr; - tab; tab; nextPutAll: 'exit(3);'; cr; - tab; nextPutAll: '}'; cr. - self versionNumberByteArrays withIndexDo: [ :v :tag | | b | - formatNumber := (self fromBytes: v) asInteger. - b := 'b_', formatNumber asString, '_', tag asString. - stream tab; nextPutAll: '{'; cr; tab; nextPutAll: 'unsigned char ', b, '[', v size asString, ']= { '. - v inject: true into: [:first : elem | - first ifFalse: [stream nextPutAll: ', ']. - stream nextPutAll: elem asString. - false]. - stream nextPutAll: '};'; cr; - tab; nextPutAll: 'if (strncmp(buf, ', b, ', ', v size asString, ') == 0) {'; cr; - tab; tab; nextPutAll: 'printf("%d", ', formatNumber, ');'; cr; - tab; tab; nextPutAll: 'exit(0);'; cr; - tab; nextPutAll: '}'; cr; tab; nextPutAll: '}'; cr]]. - stream tab; nextPutAll: 'printf("0"); /* print an invalid format number */';cr; - tab; nextPutAll: 'exit (-1); /* not found, exit with error code */'; cr; - nextPutAll: '}'; cr - ! Item was added: + ----- Method: ImageFormat class>>storeCkFormatOnFile: (in category 'ckformat') ----- + storeCkFormatOnFile: fileName + "Store source code for an image format version reader in a file. The program + is intended for testing image file format from a unix shell script such that + the shell script can decide what VM to run based on image requirements." + + | f | + f := CrLfFileStream newFileNamed: fileName. + [self generateCkFormatProgram: 'ckformat' on: f] + ensure: [f ifNotNil: [f close]]. + ^fileName! Item was changed: ----- Method: ImageFormat class>>storeCkstatusOnFile: (in category 'ckformat') ----- storeCkstatusOnFile: fileName + "Deprecated 07-Dec-2012, use storeCkFormatOnFile:" + ^self storeCkFormatOnFile: fileName + ! - "Store source code for an image format version reader in a file. The program - is intended for testing image file format from a unix shell script such that - the shell script can decide what VM to run based on image requirements." - - | f | - f := CrLfFileStream newFileNamed: fileName. - [self generateCkStatusProgram: 'ckformat' on: f] - ensure: [f ifNotNil: [f close]]. - ^fileName!

1 0

← Newer
1
2
3
4
5
6
7
8
9
10
Older →

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Vm-dev December 2012