Vm-dev November 2016

vm-dev@lists.squeakfoundation.org

34 participants
155 discussions

VM Maker: VMMaker.oscogLLP64-nice.1983.mcz
by commits＠source.squeak.org 06 Nov '16

06 Nov '16

Nicolas Cellier uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscogLLP64-nice.1983.mcz ==================== Summary ==================== Name: VMMaker.oscogLLP64-nice.1983 Author: nice Time: 6 November 2016, 9:57:28.22625 pm UUID: 40de0ca4-1f11-4afe-a938-2384056c979b Ancestors: VMMaker.oscog-nice.1982 Rebase remaining LLP64 changes on VMMaker.oscog-nice.1982 These changes are not strictly necessary and may have side effects on code generation, so they will eventually be introduced later. Mainly: - forbid usage of 'long' and 'unsigned long' in VMMaker since they are ambiguous. - correctly generateShiftLeft: for plugins too: we can't rely on (vmClass objectMemoryClass wordSize), because a plugin #isForBoth32Or64Bits - correctly generateShiftRight: by using appropriate unsigned type. Prepare for casting back to original type after shift, but do not apply yet, it uncovers a bug currently... - correctly generateIntegerObjectOf: without UB, that is with usqInt cast. - apply same optimization as #positive32BitIntegerFor: to positive32BitValueOf: and signed32BitValueOf: for 64bits - avoid using loadFloatRegs hack in FFI: there are only 16 different combinations of floating point/integer register in X64 Win64, so explicitely handle them with a switch. - Fix FFI preamble: X64 may need to getsp/setsp and WIN64 PLATFORM_API_USES_CALLEE_POPS_CONVENTION =============== Diff against VMMaker.oscog-nice.1982 =============== Item was changed: ----- Method: CCodeGenerator>>generateIntegerObjectOf:on:indent: (in category 'C translation') ----- generateIntegerObjectOf: msgNode on: aStream indent: level "Generate the C code for this message onto the given stream." + | expr mustCastToUnsigned type typeIsUnsigned | - | expr castToSqint | expr := msgNode args first. aStream nextPutAll: '(('. "Note that the default type of an integer constant in C is int. Hence we /must/ + cast expression to long if in the 64-bit world, since e.g. in 64-bits - cast constants to long if in the 64-bit world, since e.g. in 64-bits (int)(16r1FFFFF << 3) = (int)16rFFFFFFF8 = -8 whereas (long)(16r1FFFFF << 3) = (long) 16rFFFFFFF8 = 4294967288." + type := self typeFor: expr in: currentMethod. + typeIsUnsigned := type first = $u. + mustCastToUnsigned := typeIsUnsigned not + or: [(self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqInt)]. + mustCastToUnsigned ifTrue: + [aStream nextPutAll: '(usqInt)']. - castToSqint := expr isConstant and: [vmClass isNil or: [vmClass objectMemoryClass wordSize = 8]]. - castToSqint ifTrue: - [aStream nextPutAll: '(sqInt)']. self emitCExpression: expr on: aStream. aStream nextPutAll: ' << '; print: vmClass objectMemoryClass numSmallIntegerTagBits; nextPutAll: ') | 1)'! Item was changed: ----- Method: CCodeGenerator>>generateShiftLeft:on:indent: (in category 'C translation') ----- generateShiftLeft: msgNode on: aStream indent: level "Generate a C bitShift. If we can determine the result would overflow the word size, cast to a long integer." | rcvr arg castToLong type mustCastBackToSign mustCastToUnsigned canSuffixTheConstant typeIsUnsigned | rcvr := msgNode receiver. arg := msgNode args first. castToLong := false. rcvr constantNumbericValueOrNil ifNotNil: [:rcvrVal | arg constantNumbericValueOrNil + ifNil: [castToLong := self isForBoth32Or64Bits or: [vmClass notNil and: [vmClass objectMemoryClass wordSize = 8]]] - ifNil: [castToLong := vmClass notNil and: [vmClass objectMemoryClass wordSize = 8]] ifNotNil: [:argVal | | valueBeyondInt | valueBeyondInt := 1 bitShift: 32. "The default type of const << N is int." castToLong := rcvrVal < valueBeyondInt and: [(rcvrVal bitShift: argVal) >= valueBeyondInt]]]. canSuffixTheConstant := rcvr isConstant and: [rcvr name isEmpty and: [rcvr value >= 0]]. canSuffixTheConstant ifTrue: [aStream nextPutAll: (self cLiteralForUnsignedInteger: rcvr value longlong: castToLong). aStream nextPutAll: ' << '. self emitCExpression: arg on: aStream indent: level. ^self]. type := self typeFor: rcvr in: currentMethod. castToLong := castToLong and: [(self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqLong)]. typeIsUnsigned := type first = $u. mustCastToUnsigned := typeIsUnsigned not or: [castToLong or: [(self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqInt)]]. mustCastBackToSign := typeIsUnsigned not. mustCastBackToSign ifTrue: [| promotedType | promotedType := castToLong ifTrue: [#sqLong] ifFalse: [(self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #sqInt) ifTrue: [#sqInt] ifFalse: [type]]. aStream nextPutAll: '(('; nextPutAll: promotedType; nextPut: $)]. mustCastToUnsigned ifTrue: [| unsigned | unsigned := castToLong ifTrue: [#usqLong] ifFalse: [(self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqLong) ifTrue: [#usqInt] ifFalse: [self unsignedTypeForIntegralType: type]]. aStream nextPutAll: '(('; nextPutAll: unsigned; nextPutAll: ')(']. self emitCExpression: rcvr on: aStream indent: level. mustCastToUnsigned ifTrue: [aStream nextPut: $)]. aStream nextPutAll: ' << '. self emitCExpression: arg on: aStream indent: level. mustCastToUnsigned ifTrue: [aStream nextPut: $)]. mustCastBackToSign ifTrue: [aStream nextPut: $)].! Item was changed: ----- Method: CCodeGenerator>>generateShiftRight:on:indent: (in category 'C translation') ----- generateShiftRight: msgNode on: aStream indent: level "Generate the C code for this message onto the given stream." + | type isUnsigned mustCastBackToSigned mustCastToUnsigned | - | type | "If the variable is a 64-bit type then don't cast it to usqInt (typically a 32-bit type)" + type := self typeFor: msgNode receiver in: currentMethod. + isUnsigned := type first = $u. + mustCastToUnsigned := isUnsigned not. + mustCastBackToSigned := false "isUnsigned not". "FOR COMPATIBILITY WITH OLDER BEHAVIOUR, THIS MUST BE SO..." + + "If not unsigned, cast it to unsigned, and eventually cast the result back to original type." + mustCastBackToSigned ifTrue: + [aStream nextPut: $(; nextPut: $(; nextPutAll: type; nextPut: $)]. + mustCastToUnsigned ifTrue: + [aStream nextPut: $(; nextPut: $(; nextPutAll: (self unsignedTypeForIntegralType: type); nextPut: $)]. + self emitCExpression: msgNode receiver on: aStream indent: level. + mustCastToUnsigned ifTrue: + [aStream nextPut: $)]. - (self is64BitIntegralVariable: msgNode receiver typeInto: [:t| type := t]) - ifTrue: - ["If not unsigned cast it to unsigned." - type first ~= $u ifTrue: - [aStream nextPutAll: '((unsigned '; nextPutAll: type; nextPut: $)]. - self emitCExpression: msgNode receiver on: aStream indent: level. - type first ~= $u ifTrue: - [aStream nextPut: $)]] - ifFalse: - [aStream nextPutAll: '((usqInt) '. - self emitCExpression: msgNode receiver on: aStream indent: level. - aStream nextPut: $)]. aStream nextPutAll: ' >> '. + self emitCExpression: msgNode args first on: aStream indent: level. + mustCastBackToSigned ifTrue: + [aStream nextPut: $)]! - self emitCExpression: msgNode args first on: aStream indent: level! Item was added: + ----- Method: CCodeGenerator>>isForBoth32Or64Bits (in category 'testing') ----- + isForBoth32Or64Bits + "Answer true if the code is generated for both 32 and 64 bits. + Answer false otherwise. + Currently, VM source is generated for specific WordSize. + But plugins source are generated in common directory for both." + + ^self isGeneratingPluginCode! Item was changed: ----- Method: CCodeGenerator>>sizeOfIntegralCType: (in category 'inlining') ----- sizeOfIntegralCType: anIntegralCType "<String>" "N.B. Only works for values for which isIntegralCType: answers true." | prunedCType index | (anIntegralCType beginsWith: 'register ') ifTrue: [^self sizeOfIntegralCType: (anIntegralCType allButFirst: 9)]. prunedCType := (anIntegralCType beginsWith: 'unsigned ') ifTrue: [(anIntegralCType allButFirst: 9) withBlanksTrimmed] ifFalse: [(anIntegralCType beginsWith: 'signed ') ifTrue: [(anIntegralCType allButFirst: 7) withBlanksTrimmed] ifFalse: [anIntegralCType]]. ^prunedCType asString caseOf: { ['sqLong'] -> [8]. ['usqLong'] -> [8]. ['long long'] -> [8]. ['sqInt'] -> [BytesPerOop]. ['usqInt'] -> [BytesPerOop]. ['sqIntptr_t'] -> [BytesPerWord]. ['usqIntptr_t'] -> [BytesPerWord]. ['int'] -> [4]. ['short'] -> [2]. ['short int'] -> [2]. ['char'] -> [1]. - ['long'] -> [BytesPerWord]. "It's ambiguous on LLP64 and we'll later remove it" ['size_t'] -> [BytesPerWord]. ['pid_t'] -> [BytesPerWord]. } otherwise: + [prunedCType = #long ifTrue: [self error: 'long is ambiguous on 64bits architecture, don''t use it'. ^BytesPerWord]. + ((anIntegralCType beginsWith: 'unsigned') "e.g. 'unsigned : 8'" - [((anIntegralCType beginsWith: 'unsigned') "e.g. 'unsigned : 8'" and: [(anIntegralCType includesAnyOf: '[*]') not and: [(index := anIntegralCType indexOf: $:) > 0]]) ifTrue: [(Integer readFrom: (anIntegralCType copyFrom: index + 1 to: anIntegralCType size) withBlanksTrimmed readStream) + 7 // 8] ifFalse: [self error: 'unrecognized integral type']]! Item was changed: ----- Method: InterpreterPlugin>>sizeof: (in category 'simulation support') ----- sizeof: objectSymbolOrClass <doNotGenerate> - objectSymbolOrClass isInteger ifTrue: - [^interpreterProxy wordSize]. objectSymbolOrClass isSymbol ifTrue: ["In the simulator file handles are just integer indices into openFiles and so need only be BytesPerWord big. But in the actual VM they are at least 5 words long." objectSymbolOrClass == #SQFile ifTrue: [^interpreterProxy wordSize * 5]. "SQSocket is typedef struct { int sessionID; int socketType; void *privateSocketPtr; } SQSocket" objectSymbolOrClass == #SQSocket ifTrue: [^8 + interpreterProxy wordSize]. "We assume the file offset type is always 64-bits." objectSymbolOrClass == #squeakFileOffsetType ifTrue: [^8]. (objectSymbolOrClass last == $* - or: [#long == objectSymbolOrClass - or: [#'unsigned long' == objectSymbolOrClass or: [#'sqIntptr_t' == objectSymbolOrClass or: [#'usqIntptr_t' == objectSymbolOrClass + or: [#'size_t' == objectSymbolOrClass]]]) ifTrue: - or: [#'size_t' == objectSymbolOrClass]]]]]) ifTrue: [^interpreterProxy wordSize]. (#(usqInt sqInt) includes: objectSymbolOrClass) ifTrue: [^interpreterProxy bytesPerOop]]. ^super sizeof: objectSymbolOrClass! Item was added: + ----- Method: InterpreterPrimitives>>maybeInlinePositive32BitValueOf: (in category 'primitive support') ----- + maybeInlinePositive32BitValueOf: oop + "Convert the given object into an integer value. + The object may be either a positive SmallInteger or a four-byte LargePositiveInteger." + <notOption: #Spur64BitMemoryManager> + <returnTypeC: #'unsigned int'> + | value ok sz | + (objectMemory isIntegerObject: oop) ifTrue: + [value := objectMemory integerValueOf: oop. + (value < 0) ifTrue: + [self primitiveFail. value := 0]. + ^value]. + + (objectMemory isNonIntegerImmediate: oop) + ifTrue: + [self primitiveFail. + ^0] + ifFalse: + [ok := objectMemory + isClassOfNonImm: oop + equalTo: (objectMemory splObj: ClassLargePositiveInteger) + compactClassIndex: ClassLargePositiveIntegerCompactIndex. + ok ifFalse: + [self primitiveFail. + ^0]. + sz := objectMemory numBytesOfBytes: oop. + sz > 4 ifTrue: + [self primitiveFail. + ^0]. + ^self cCoerceSimple: (objectMemory byteSwapped32IfBigEndian: (objectMemory fetchLong32: 0 ofObject: oop)) to: #'unsigned int']! Item was added: + ----- Method: InterpreterPrimitives>>noInlineSigned32BitValueOf: (in category 'primitive support') ----- + noInlineSigned32BitValueOf: oop + "Convert the given object into an integer value. + The object may be either a SmallInteger or a four-byte LargeInteger." + | value negative ok magnitude | + <notOption: #Spur64BitMemoryManager> + <inline: false> + <returnTypeC: #int> + <var: #value type: #int> + <var: #magnitude type: #'unsigned int'> + self deny: objectMemory hasSixtyFourBitImmediates. + (objectMemory isIntegerObject: oop) ifTrue: + [^objectMemory integerValueOf: oop]. + + (objectMemory isNonIntegerImmediate: oop) ifTrue: + [self primitiveFail. + ^0]. + + ok := objectMemory + isClassOfNonImm: oop + equalTo: (objectMemory splObj: ClassLargePositiveInteger) + compactClassIndex: ClassLargePositiveIntegerCompactIndex. + ok + ifTrue: [negative := false] + ifFalse: + [negative := true. + ok := objectMemory isClassOfNonImm: oop + equalTo: (objectMemory splObj: ClassLargeNegativeInteger) + compactClassIndex: ClassLargeNegativeIntegerCompactIndex. + ok ifFalse: + [self primitiveFail. + ^0]]. + (objectMemory numBytesOfBytes: oop) > 4 ifTrue: + [^self primitiveFail]. + + magnitude := self cCoerceSimple: (objectMemory byteSwapped32IfBigEndian: (objectMemory fetchLong32: 0 ofObject: oop)) to: #'unsigned int'. + + (negative + ifTrue: [magnitude > 16r80000000] + ifFalse: [magnitude >= 16r80000000]) + ifTrue: + [self primitiveFail. + ^0]. + negative + ifTrue: [value := 0 - magnitude] + ifFalse: [value := magnitude]. + ^value! Item was changed: ----- Method: InterpreterPrimitives>>positive32BitValueOf: (in category 'primitive support') ----- positive32BitValueOf: oop "Convert the given object into an integer value. The object may be either a positive SmallInteger or a four-byte LargePositiveInteger." + <returnTypeC: #'unsigned int'> + objectMemory hasSixtyFourBitImmediates - <returnTypeC: #usqInt> - | value ok sz | - (objectMemory isIntegerObject: oop) ifTrue: - [value := objectMemory integerValueOf: oop. - (value < 0 - or: [objectMemory wordSize > 4 - and: [self cCode: [(self cCoerceSimple: value to: #'unsigned int') ~= value] - inSmalltalk: [value >> 32 ~= 0]]]) ifTrue: - [self primitiveFail. value := 0]. - ^value]. - - (objectMemory hasSixtyFourBitImmediates - or: [objectMemory isNonIntegerImmediate: oop]) ifTrue: + [(objectMemory isIntegerObject: oop) ifTrue: + [| value64 | + value64 := objectMemory integerValueOf: oop. + (value64 < 0 + or: [self cCode: [(self cCoerceSimple: value64 to: #'unsigned int') ~= value64] + inSmalltalk: [value64 >> 32 ~= 0]]) ifTrue: + [self primitiveFail. value64 := 0]. + ^value64]. + self primitiveFail. + ^0] - [self primitiveFail. - ^0] ifFalse: + [^self maybeInlinePositive32BitValueOf: oop]! - [ok := objectMemory - isClassOfNonImm: oop - equalTo: (objectMemory splObj: ClassLargePositiveInteger) - compactClassIndex: ClassLargePositiveIntegerCompactIndex. - ok ifFalse: - [self primitiveFail. - ^0]. - sz := objectMemory numBytesOfBytes: oop. - sz > 4 ifTrue: - [self primitiveFail. - ^0]. - ^self cCoerceSimple: (objectMemory byteSwapped32IfBigEndian: (objectMemory fetchLong32: 0 ofObject: oop)) to: #'unsigned int']! Item was changed: ----- Method: InterpreterPrimitives>>signed32BitValueOf: (in category 'primitive support') ----- signed32BitValueOf: oop "Convert the given object into an integer value. + The object may be either a SmallInteger or a four-byte LargeInteger." - The object may be either a positive SmallInteger or a four-byte LargeInteger." - | value negative ok magnitude | - <inline: false> <returnTypeC: #int> + + objectMemory hasSixtyFourBitImmediates + ifTrue: + [(objectMemory isIntegerObject: oop) ifTrue: - <var: #value type: #int> - <var: #magnitude type: #'unsigned int'> - <var: #value64 type: #long> - (objectMemory isIntegerObject: oop) ifTrue: - [objectMemory wordSize = 4 - ifTrue: - [^objectMemory integerValueOf: oop] - ifFalse: "Must fail for SmallIntegers with digitLength > 4" [| value64 | value64 := objectMemory integerValueOf: oop. (self cCode: [(self cCoerceSimple: value64 to: #int) ~= value64] inSmalltalk: [value64 >> 31 ~= 0 and: [value64 >> 31 ~= -1]]) ifTrue: [self primitiveFail. value64 := 0]. + ^value64]. + self primitiveFail. + ^0] - ^value64]]. - - (objectMemory isNonIntegerImmediate: oop) ifTrue: - [self primitiveFail. - ^0]. - - ok := objectMemory - isClassOfNonImm: oop - equalTo: (objectMemory splObj: ClassLargePositiveInteger) - compactClassIndex: ClassLargePositiveIntegerCompactIndex. - ok - ifTrue: [negative := false] ifFalse: + [^self noInlineSigned32BitValueOf: oop]! - [negative := true. - ok := objectMemory isClassOfNonImm: oop - equalTo: (objectMemory splObj: ClassLargeNegativeInteger) - compactClassIndex: ClassLargeNegativeIntegerCompactIndex. - ok ifFalse: - [self primitiveFail. - ^0]]. - (objectMemory numBytesOfBytes: oop) > 4 ifTrue: - [^self primitiveFail]. - - magnitude := self cCoerceSimple: (objectMemory byteSwapped32IfBigEndian: (objectMemory fetchLong32: 0 ofObject: oop)) to: #'unsigned int'. - - (negative - ifTrue: [magnitude > 16r80000000] - ifFalse: [magnitude >= 16r80000000]) - ifTrue: - [self primitiveFail. - ^0]. - negative - ifTrue: [value := 0 - magnitude] - ifFalse: [value := magnitude]. - ^value! Item was changed: ----- Method: InterpreterProxy>>ioLoadSymbol:OfLength:FromModule: (in category 'FFI support') ----- ioLoadSymbol: functionNameIndex OfLength: functionLength FromModule: moduleHandle <returnTypeC: #'void *'> + <var: 'moduleHandle' type: #'void *'> "Dummy - provided by support code" ^0! Item was changed: ----- Method: LargeIntegersPlugin>>anyBitOfLargeInt:from:to: (in category 'util') ----- anyBitOfLargeInt: anOop from: start to: stopArg "Argument has to be a Large Integer!!" "Tests for any magnitude bits in the interval from start to stopArg." | magnitude stop firstDigitIx lastDigitIx firstMask lastMask | <var: #digit type: #'unsigned int'> <var: #firstMask type: #'unsigned int'> <var: #lastMask type: #'unsigned int'> <var: #firstDigitIx type: #usqInt> <var: #lastDigitIx type: #usqInt> <var: #ix type: #usqInt> self debugCode: [self msg: 'anyBitOfLargeInt: anOop from: start to: stopArg']. start < 1 | (stopArg < 1) ifTrue: [^ interpreterProxy primitiveFail]. magnitude := anOop. stop := stopArg min: (self highBitOfLargeInt: magnitude). start > stop ifTrue: [^ false]. firstDigitIx := start - 1 // 32 + 1. lastDigitIx := stop - 1 // 32 + 1. + firstMask := 16rFFFFFFFF << (start - 1 bitAnd: 31). - firstMask := 16rFFFFFFFF asUnsignedLong << (start - 1 bitAnd: 31). "Note asUnsignedLong required to avoid ULLL suffix bug" lastMask := 16rFFFFFFFF >> (31 - (stop - 1 bitAnd: 31)). firstDigitIx = lastDigitIx ifTrue: [| digit | digit := self unsafeDigitOfLargeInt: magnitude at: firstDigitIx. ^ (digit bitAnd: (firstMask bitAnd: lastMask)) ~= 0]. ((self unsafeDigitOfLargeInt: magnitude at: firstDigitIx) bitAnd: firstMask) ~= 0 ifTrue: [^ true]. firstDigitIx + 1 to: lastDigitIx - 1 do: [:ix | (self unsafeDigitOfLargeInt: magnitude at: ix) ~= 0 ifTrue: [^ true]]. ((self unsafeDigitOfLargeInt: magnitude at: lastDigitIx) bitAnd: lastMask) ~= 0 ifTrue: [^ true]. ^ false! Item was changed: ----- Method: TMethod>>isFunctional (in category 'inlining') ----- isFunctional "Answer true if the receiver is a functional method. That is, if it consists of a single return statement of an expression that contains no other returns. Answer false for methods with return types other than the simple integer types to work around bugs in the inliner." parseTree statements isEmpty ifTrue: [^false]. parseTree statements last isReturn ifFalse: [^false]. parseTree statements size = 1 ifFalse: [(parseTree statements size = 2 and: [parseTree statements first isSend and: [parseTree statements first selector == #flag:]]) ifFalse: [^false]]. parseTree statements last expression nodesDo: [ :n | n isReturn ifTrue: [^false]]. + ^#(int #'unsigned int' #'long long' #'unsigned long long' - ^#(int #'unsigned int' #long #'unsigned long' #'long long' #'unsigned long long' sqInt usqInt #'sqIntptr_t' #'usqIntptr_t' sqLong usqLong #'int *' #'unsigned int *' #'sqInt *' #'usqInt *' #'sqLong *' #'usqLong *' #'CogMethod *' #'char *') includes: returnType! Item was changed: ----- Method: ThreadedFFIPlugin class>>preambleCCode (in category 'translation') ----- preambleCCode "For a source of builtin defines grep for builtin_define in a gcc release config directory." ^' #include "sqAssert.h" /* for assert */ #define ThreadedFFIPlugin 1 /* to filter-out unwanted declarations from sqFFI.h */ #include "sqFFI.h" /* for logging and surface functions */ #ifdef _MSC_VER # define alloca _alloca #endif #if defined(__GNUC__) && (defined(_X86_) || defined(i386) || defined(__i386) || defined(__i386__)) # define setsp(sp) asm volatile ("movl %0,%%esp" : : "m"(sp)) # define getsp() ({ void *esp; asm volatile ("movl %%esp,%0" : "=r"(esp) : ); esp;}) + # elif defined(__GNUC__) && (defined(__amd64__) || defined(__x86_64__) || defined(__amd64) || defined(__x86_64)) + # define setsp(sp) asm volatile ("movq %0,%%rsp" : : "m"(sp)) + # define getsp() ({ void *rsp; asm volatile ("movq %%rsp,%0" : "=r"(rsp) : ); rsp;}) # elif defined(__GNUC__) && (defined(__arm__)) # define setsp(sp) asm volatile ("ldr %%sp, %0" : : "m"(sp)) # define getsp() ({ void *sp; asm volatile ("mov %0, %%sp" : "=r"(sp) : ); sp;}) #endif #if !!defined(getsp) # define getsp() 0 #endif #if !!defined(setsp) # define setsp(ignored) 0 #endif #if !!defined(STACK_ALIGN_BYTES) # if __APPLE__ && __MACH__ && __i386__ # define STACK_ALIGN_BYTES 16 # elif __linux__ && __i386__ # define STACK_ALIGN_BYTES 16 # elif defined(__amd64__) || defined(__x86_64__) || defined(__amd64) || defined(__x86_64) # define STACK_ALIGN_BYTES 16 # elif defined(powerpc) || defined(__powerpc__) || defined(_POWER) || defined(__POWERPC__) || defined(__PPC__) # define STACK_ALIGN_BYTES 16 # elif defined(__sparc64__) || defined(__sparcv9__) || defined(__sparc_v9__) /* must precede 32-bit sparc defs */ # define STACK_ALIGN_BYTES 16 # elif defined(sparc) || defined(__sparc__) || defined(__sparclite__) # define STACK_ALIGN_BYTES 8 # elif defined(__arm__) # define STACK_ALIGN_BYTES 8 # else # define STACK_ALIGN_BYTES 0 # endif #endif /* !!defined(STACK_ALIGN_BYTES) */ #if !!defined(STACK_OFFSET_BYTES) # define STACK_OFFSET_BYTES 0 #endif #if defined(_X86_) || defined(i386) || defined(__i386) || defined(__i386__) /* Both Mac OS X x86 and Win32 x86 return structs of a power of two in size * less than or equal to eight bytes in length in registers. Linux never does so. */ # if __linux__ # define WIN32_X86_STRUCT_RETURN 0 # else # define WIN32_X86_STRUCT_RETURN 1 # endif # if WIN32 # define PLATFORM_API_USES_CALLEE_POPS_CONVENTION 1 # endif + # elif defined(__amd64__) || defined(__x86_64__) || defined(__amd64) || defined(__x86_64) + # if WIN32 | WIN64 + # define PLATFORM_API_USES_CALLEE_POPS_CONVENTION 1 + # endif #endif /* defined(_X86_) || defined(i386) || defined(__i386) || defined(__i386__) */ #if !!defined(ALLOCA_LIES_SO_USE_GETSP) + # if defined(__MINGW32__) && (__GNUC__ >= 3) && (defined(_X86_) || defined(i386) || defined(__i386) || defined(__i386__)) - # if defined(__MINGW32__) && (__GNUC__ >= 3) /* * cygwin -mno-cygwin (MinGW) gcc 3.4.x''s alloca is a library routine that answers * %esp + 4, so the outgoing stack is offset by one word if uncorrected. * Grab the actual stack pointer to correct. */ # define ALLOCA_LIES_SO_USE_GETSP 1 # else # define ALLOCA_LIES_SO_USE_GETSP 0 # endif #endif /* !!defined(ALLOCA_LIES_SO_USE_GETSP) */ #if !!defined(PLATFORM_API_USES_CALLEE_POPS_CONVENTION) # define PLATFORM_API_USES_CALLEE_POPS_CONVENTION 0 #endif /* The dispatchOn:in:with:with: generates an unwanted call on error. Just squash it. */ #define error(foo) 0 #ifndef SQUEAK_BUILTIN_PLUGIN /* but print assert failures. */ void warning(char *s) { /* Print an error message but don''t exit. */ printf("\n%s\n", s); } #endif /* sanitize */ #ifdef SQUEAK_BUILTIN_PLUGIN # define EXTERN #else # define EXTERN extern #endif '! Item was added: + ----- Method: ThreadedX64Win64FFIPlugin>>ffiCalloutDoubleRetTo:in: (in category 'callout support') ----- + ffiCalloutDoubleRetTo: procAddr in: calloutState + <var: #procAddr type: #'void *'> + <var: #calloutState type: #'CalloutState *'> + | floatRet | + <var: #floatRet type: #double> + <returnTypeC: #double> + <inline: true> + calloutState floatRegisterSignature caseOf: { + [0]-> [floatRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') + with: (calloutState integerRegisters at: 0) + with: (calloutState integerRegisters at: 1) + with: (calloutState integerRegisters at: 2) + with: (calloutState integerRegisters at: 3)]. + [1]-> [floatRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(double, sqIntptr_t, sqIntptr_t, sqIntptr_t)') + with: (calloutState floatRegisters at: 0) + with: (calloutState integerRegisters at: 1) + with: (calloutState integerRegisters at: 2) + with: (calloutState integerRegisters at: 3)]. + [2]-> [floatRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(sqIntptr_t, double, sqIntptr_t, sqIntptr_t)') + with: (calloutState integerRegisters at: 0) + with: (calloutState floatRegisters at: 1) + with: (calloutState integerRegisters at: 2) + with: (calloutState integerRegisters at: 3)]. + [3]-> [floatRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(double, double, sqIntptr_t, sqIntptr_t)') + with: (calloutState floatRegisters at: 0) + with: (calloutState floatRegisters at: 1) + with: (calloutState integerRegisters at: 2) + with: (calloutState integerRegisters at: 3)]. + [4]-> [floatRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(sqIntptr_t, sqIntptr_t, double, sqIntptr_t)') + with: (calloutState integerRegisters at: 0) + with: (calloutState integerRegisters at: 1) + with: (calloutState floatRegisters at: 2) + with: (calloutState integerRegisters at: 3)]. + [5]-> [floatRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(double, sqIntptr_t, double, sqIntptr_t)') + with: (calloutState floatRegisters at: 0) + with: (calloutState integerRegisters at: 1) + with: (calloutState floatRegisters at: 2) + with: (calloutState integerRegisters at: 3)]. + [6]-> [floatRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(sqIntptr_t, double, double, sqIntptr_t)') + with: (calloutState integerRegisters at: 0) + with: (calloutState floatRegisters at: 1) + with: (calloutState floatRegisters at: 2) + with: (calloutState integerRegisters at: 3)]. + [7]-> [floatRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(double, double, double, sqIntptr_t)') + with: (calloutState floatRegisters at: 0) + with: (calloutState floatRegisters at: 1) + with: (calloutState floatRegisters at: 2) + with: (calloutState integerRegisters at: 3)]. + + [8]-> [floatRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, double)') + with: (calloutState integerRegisters at: 0) + with: (calloutState integerRegisters at: 1) + with: (calloutState integerRegisters at: 2) + with: (calloutState floatRegisters at: 3)]. + [9]-> [floatRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(double, sqIntptr_t, sqIntptr_t, double)') + with: (calloutState floatRegisters at: 0) + with: (calloutState integerRegisters at: 1) + with: (calloutState integerRegisters at: 2) + with: (calloutState floatRegisters at: 3)]. + [10]-> [floatRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(sqIntptr_t, double, sqIntptr_t, double)') + with: (calloutState integerRegisters at: 0) + with: (calloutState floatRegisters at: 1) + with: (calloutState integerRegisters at: 2) + with: (calloutState floatRegisters at: 3)]. + [11]-> [floatRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(double, double, sqIntptr_t, double)') + with: (calloutState floatRegisters at: 0) + with: (calloutState floatRegisters at: 1) + with: (calloutState integerRegisters at: 2) + with: (calloutState floatRegisters at: 3)]. + [12]-> [floatRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(sqIntptr_t, sqIntptr_t, double, double)') + with: (calloutState integerRegisters at: 0) + with: (calloutState integerRegisters at: 1) + with: (calloutState floatRegisters at: 2) + with: (calloutState floatRegisters at: 3)]. + [13]-> [floatRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(double, sqIntptr_t, double, double)') + with: (calloutState floatRegisters at: 0) + with: (calloutState integerRegisters at: 1) + with: (calloutState floatRegisters at: 2) + with: (calloutState floatRegisters at: 3)]. + [14]-> [floatRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(sqIntptr_t, double, double, double)') + with: (calloutState integerRegisters at: 0) + with: (calloutState floatRegisters at: 1) + with: (calloutState floatRegisters at: 2) + with: (calloutState floatRegisters at: 3)]. + [15]-> [floatRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(double, double, double, double)') + with: (calloutState floatRegisters at: 0) + with: (calloutState floatRegisters at: 1) + with: (calloutState floatRegisters at: 2) + with: (calloutState floatRegisters at: 3)].} otherwise: [floatRet := 0]. + ^floatRet! Item was added: + ----- Method: ThreadedX64Win64FFIPlugin>>ffiCalloutFloatRetTo:in: (in category 'callout support') ----- + ffiCalloutFloatRetTo: procAddr in: calloutState + <var: #procAddr type: #'void *'> + <var: #calloutState type: #'CalloutState *'> + | floatRet | + <var: #floatRet type: #double> "It's double rather than float because it will be converted to a squeak Float object (a.k.a. double precision)" + <returnTypeC: #double> + <inline: true> + calloutState floatRegisterSignature caseOf: { + [0]-> [floatRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') + with: (calloutState integerRegisters at: 0) + with: (calloutState integerRegisters at: 1) + with: (calloutState integerRegisters at: 2) + with: (calloutState integerRegisters at: 3)]. + [1]-> [floatRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(double, sqIntptr_t, sqIntptr_t, sqIntptr_t)') + with: (calloutState floatRegisters at: 0) + with: (calloutState integerRegisters at: 1) + with: (calloutState integerRegisters at: 2) + with: (calloutState integerRegisters at: 3)]. + [2]-> [floatRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(sqIntptr_t, double, sqIntptr_t, sqIntptr_t)') + with: (calloutState integerRegisters at: 0) + with: (calloutState floatRegisters at: 1) + with: (calloutState integerRegisters at: 2) + with: (calloutState integerRegisters at: 3)]. + [3]-> [floatRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(double, double, sqIntptr_t, sqIntptr_t)') + with: (calloutState floatRegisters at: 0) + with: (calloutState floatRegisters at: 1) + with: (calloutState integerRegisters at: 2) + with: (calloutState integerRegisters at: 3)]. + [4]-> [floatRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(sqIntptr_t, sqIntptr_t, double, sqIntptr_t)') + with: (calloutState integerRegisters at: 0) + with: (calloutState integerRegisters at: 1) + with: (calloutState floatRegisters at: 2) + with: (calloutState integerRegisters at: 3)]. + [5]-> [floatRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(double, sqIntptr_t, double, sqIntptr_t)') + with: (calloutState floatRegisters at: 0) + with: (calloutState integerRegisters at: 1) + with: (calloutState floatRegisters at: 2) + with: (calloutState integerRegisters at: 3)]. + [6]-> [floatRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(sqIntptr_t, double, double, sqIntptr_t)') + with: (calloutState integerRegisters at: 0) + with: (calloutState floatRegisters at: 1) + with: (calloutState floatRegisters at: 2) + with: (calloutState integerRegisters at: 3)]. + [7]-> [floatRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(double, double, double, sqIntptr_t)') + with: (calloutState floatRegisters at: 0) + with: (calloutState floatRegisters at: 1) + with: (calloutState floatRegisters at: 2) + with: (calloutState integerRegisters at: 3)]. + + [8]-> [floatRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, double)') + with: (calloutState integerRegisters at: 0) + with: (calloutState integerRegisters at: 1) + with: (calloutState integerRegisters at: 2) + with: (calloutState floatRegisters at: 3)]. + [9]-> [floatRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(double, sqIntptr_t, sqIntptr_t, double)') + with: (calloutState floatRegisters at: 0) + with: (calloutState integerRegisters at: 1) + with: (calloutState integerRegisters at: 2) + with: (calloutState floatRegisters at: 3)]. + [10]-> [floatRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(sqIntptr_t, double, sqIntptr_t, double)') + with: (calloutState integerRegisters at: 0) + with: (calloutState floatRegisters at: 1) + with: (calloutState integerRegisters at: 2) + with: (calloutState floatRegisters at: 3)]. + [11]-> [floatRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(double, double, sqIntptr_t, double)') + with: (calloutState floatRegisters at: 0) + with: (calloutState floatRegisters at: 1) + with: (calloutState integerRegisters at: 2) + with: (calloutState floatRegisters at: 3)]. + [12]-> [floatRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(sqIntptr_t, sqIntptr_t, double, double)') + with: (calloutState integerRegisters at: 0) + with: (calloutState integerRegisters at: 1) + with: (calloutState floatRegisters at: 2) + with: (calloutState floatRegisters at: 3)]. + [13]-> [floatRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(double, sqIntptr_t, double, double)') + with: (calloutState floatRegisters at: 0) + with: (calloutState integerRegisters at: 1) + with: (calloutState floatRegisters at: 2) + with: (calloutState floatRegisters at: 3)]. + [14]-> [floatRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(sqIntptr_t, double, double, double)') + with: (calloutState integerRegisters at: 0) + with: (calloutState floatRegisters at: 1) + with: (calloutState floatRegisters at: 2) + with: (calloutState floatRegisters at: 3)]. + [15]-> [floatRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(double, double, double, double)') + with: (calloutState floatRegisters at: 0) + with: (calloutState floatRegisters at: 1) + with: (calloutState floatRegisters at: 2) + with: (calloutState floatRegisters at: 3)].} otherwise: [floatRet := 0]. + ^floatRet! Item was added: + ----- Method: ThreadedX64Win64FFIPlugin>>ffiCalloutIntRetTo:in: (in category 'callout support') ----- + ffiCalloutIntRetTo: procAddr in: calloutState + <var: #procAddr type: #'void *'> + <var: #calloutState type: #'CalloutState *'> + | intRet | + <var: #intRet type: #usqLong> + <returnTypeC: #usqLong> + <inline: true> + calloutState floatRegisterSignature caseOf: { + [0]-> [intRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqLong (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') + with: (calloutState integerRegisters at: 0) + with: (calloutState integerRegisters at: 1) + with: (calloutState integerRegisters at: 2) + with: (calloutState integerRegisters at: 3)]. + [1]-> [intRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqLong (*)(double, sqIntptr_t, sqIntptr_t, sqIntptr_t)') + with: (calloutState floatRegisters at: 0) + with: (calloutState integerRegisters at: 1) + with: (calloutState integerRegisters at: 2) + with: (calloutState integerRegisters at: 3)]. + [2]-> [intRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqLong (*)(sqIntptr_t, double, sqIntptr_t, sqIntptr_t)') + with: (calloutState integerRegisters at: 0) + with: (calloutState floatRegisters at: 1) + with: (calloutState integerRegisters at: 2) + with: (calloutState integerRegisters at: 3)]. + [3]-> [intRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqLong (*)(double, double, sqIntptr_t, sqIntptr_t)') + with: (calloutState floatRegisters at: 0) + with: (calloutState floatRegisters at: 1) + with: (calloutState integerRegisters at: 2) + with: (calloutState integerRegisters at: 3)]. + [4]-> [intRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqLong (*)(sqIntptr_t, sqIntptr_t, double, sqIntptr_t)') + with: (calloutState integerRegisters at: 0) + with: (calloutState integerRegisters at: 1) + with: (calloutState floatRegisters at: 2) + with: (calloutState integerRegisters at: 3)]. + [5]-> [intRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqLong (*)(double, sqIntptr_t, double, sqIntptr_t)') + with: (calloutState floatRegisters at: 0) + with: (calloutState integerRegisters at: 1) + with: (calloutState floatRegisters at: 2) + with: (calloutState integerRegisters at: 3)]. + [6]-> [intRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqLong (*)(sqIntptr_t, double, double, sqIntptr_t)') + with: (calloutState integerRegisters at: 0) + with: (calloutState floatRegisters at: 1) + with: (calloutState floatRegisters at: 2) + with: (calloutState integerRegisters at: 3)]. + [7]-> [intRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqLong (*)(double, double, double, sqIntptr_t)') + with: (calloutState floatRegisters at: 0) + with: (calloutState floatRegisters at: 1) + with: (calloutState floatRegisters at: 2) + with: (calloutState integerRegisters at: 3)]. + + [8]-> [intRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqLong (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, double)') + with: (calloutState integerRegisters at: 0) + with: (calloutState integerRegisters at: 1) + with: (calloutState integerRegisters at: 2) + with: (calloutState floatRegisters at: 3)]. + [9]-> [intRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqLong (*)(double, sqIntptr_t, sqIntptr_t, double)') + with: (calloutState floatRegisters at: 0) + with: (calloutState integerRegisters at: 1) + with: (calloutState integerRegisters at: 2) + with: (calloutState floatRegisters at: 3)]. + [10]-> [intRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqLong (*)(sqIntptr_t, double, sqIntptr_t, double)') + with: (calloutState integerRegisters at: 0) + with: (calloutState floatRegisters at: 1) + with: (calloutState integerRegisters at: 2) + with: (calloutState floatRegisters at: 3)]. + [11]-> [intRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqLong (*)(double, double, sqIntptr_t, double)') + with: (calloutState floatRegisters at: 0) + with: (calloutState floatRegisters at: 1) + with: (calloutState integerRegisters at: 2) + with: (calloutState floatRegisters at: 3)]. + [12]-> [intRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqLong (*)(sqIntptr_t, sqIntptr_t, double, double)') + with: (calloutState integerRegisters at: 0) + with: (calloutState integerRegisters at: 1) + with: (calloutState floatRegisters at: 2) + with: (calloutState floatRegisters at: 3)]. + [13]-> [intRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqLong (*)(double, sqIntptr_t, double, double)') + with: (calloutState floatRegisters at: 0) + with: (calloutState integerRegisters at: 1) + with: (calloutState floatRegisters at: 2) + with: (calloutState floatRegisters at: 3)]. + [14]-> [intRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqLong (*)(sqIntptr_t, double, double, double)') + with: (calloutState integerRegisters at: 0) + with: (calloutState floatRegisters at: 1) + with: (calloutState floatRegisters at: 2) + with: (calloutState floatRegisters at: 3)]. + [15]-> [intRet := self + dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqLong (*)(double, double, double, double)') + with: (calloutState floatRegisters at: 0) + with: (calloutState floatRegisters at: 1) + with: (calloutState floatRegisters at: 2) + with: (calloutState floatRegisters at: 3)].} otherwise: [intRet := 0]. + ^intRet! Item was changed: ----- Method: ThreadedX64Win64FFIPlugin>>ffiCalloutTo:SpecOnStack:in: (in category 'callout support') ----- ffiCalloutTo: procAddr SpecOnStack: specOnStack in: calloutState <var: #procAddr type: #'void *'> <var: #calloutState type: #'CalloutState *'> - <var: #loadFloatRegs declareC: 'extern void loadFloatRegs(double, double, double, double)'> "Go out, call this guy and create the return value. This *must* be inlined because of the alloca of the outgoing stack frame in ffiCall:WithFlags:NumArgs:Args:AndTypes:" | myThreadIndex atomicType floatRet intRet loadFloatRegs oop | <var: #floatRet type: #double> <var: #intRet type: #usqLong> <inline: true> self cCode: '' inSmalltalk: [loadFloatRegs := #used. loadFloatRegs class]. self cppIf: COGMTVM ifTrue: [(calloutState callFlags anyMask: FFICallFlagThreaded) ifTrue: [myThreadIndex := interpreterProxy disownVM: 0]]. self registerArgsSlop + self cStackAlignment > 0 ifTrue: [self setsp: calloutState argVector]. - calloutState floatRegisterSignature > 0 ifTrue: - [self - load: (calloutState floatRegisters at: 0) - Flo: (calloutState floatRegisters at: 1) - at: (calloutState floatRegisters at: 2) - Re: (calloutState floatRegisters at: 3) - gs: (calloutState floatRegisters at: 4)]. - atomicType := self atomicTypeOf: calloutState ffiRetHeader. (atomicType >> 1) = (FFITypeSingleFloat >> 1) ifTrue: [atomicType = FFITypeSingleFloat ifTrue: + [floatRet := self ffiCalloutFloatRetTo: procAddr in: calloutState] - [floatRet := self - dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(long, long, long, long)') - with: (calloutState integerRegisters at: 0) - with: (calloutState integerRegisters at: 1) - with: (calloutState integerRegisters at: 2) - with: (calloutState integerRegisters at: 3)] ifFalse: "atomicType = FFITypeDoubleFloat" + [floatRet := self ffiCalloutDoubleRetTo: procAddr in: calloutState]] - [floatRet := self - dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(long, long, long, long)') - with: (calloutState integerRegisters at: 0) - with: (calloutState integerRegisters at: 1) - with: (calloutState integerRegisters at: 2) - with: (calloutState integerRegisters at: 3)]] ifFalse: + [intRet := self ffiCalloutIntRetTo: procAddr in: calloutState]. - [intRet := self - dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqLong (*)(long, long, long, long)') - with: (calloutState integerRegisters at: 0) - with: (calloutState integerRegisters at: 1) - with: (calloutState integerRegisters at: 2) - with: (calloutState integerRegisters at: 3)]. "undo any callee argument pops because it may confuse stack management with the alloca." (self isCalleePopsConvention: calloutState callFlags) ifTrue: [self setsp: calloutState argVector]. self cppIf: COGMTVM ifTrue: [(calloutState callFlags anyMask: FFICallFlagThreaded) ifTrue: [interpreterProxy ownVM: myThreadIndex]]. (calloutState ffiRetHeader anyMask: FFIFlagPointer+FFIFlagStructure) ifTrue: ["Note: Order is important here since FFIFlagPointer + FFIFlagStructure is used to represent 'typedef void* VoidPointer' and VoidPointer must be returned as pointer *not* as struct." (calloutState ffiRetHeader anyMask: FFIFlagPointer) ifTrue: [oop := self ffiReturnPointer: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState] ifFalse: [oop := self ffiReturnStruct: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState]. ^oop]. (atomicType >> 1) = (FFITypeSingleFloat >> 1) ifTrue: [oop := interpreterProxy floatObjectOf: floatRet] ifFalse: [oop := self ffiCreateIntegralResultOop: intRet ofAtomicType: atomicType in: calloutState]. ^interpreterProxy methodReturnValue: oop! Item was changed: ----- Method: VMClass>>sizeof: (in category 'translation support') ----- sizeof: objectSymbolOrClass <doNotGenerate> | index | objectSymbolOrClass isInteger ifTrue: [^self class objectMemoryClass wordSize]. (#(usqInt sqInt) includes: objectSymbolOrClass) ifTrue: [^self class objectMemoryClass bytesPerOop]. objectSymbolOrClass isSymbol ifTrue: [(objectSymbolOrClass last == $* + or: [#(#'sqIntptr_t' #'usqIntptr_t' #'size_t') includes: objectSymbolOrClass]) ifTrue: - or: [#(#long #'unsigned long' #'sqIntptr_t' #'usqIntptr_t' #'size_t') includes: objectSymbolOrClass]) ifTrue: [^self class objectMemoryClass wordSize]. index := #( #sqLong #usqLong #double #int #'unsigned int' #float #short #'unsigned short' #char #'unsigned char' #'signed char') indexOf: objectSymbolOrClass ifAbsent: + [(#(long #'unsigned long') includes: objectSymbolOrClass) + ifTrue: + [self error: 'long is ambiguous on 64bits architecture, don''t use it'. + ^self class objectMemoryClass wordSize]. + self error: 'unrecognized C type name']. - [self error: 'unrecognized C type name']. ^#(8 8 8 4 4 4 2 2 1 1 1) at: index]. ^(objectSymbolOrClass isBehavior ifTrue: [objectSymbolOrClass] ifFalse: [objectSymbolOrClass class]) alignedByteSizeOf: objectSymbolOrClass forClient: self!

1 0

VM Maker: VMMaker.oscog-nice.1982.mcz
by commits＠source.squeak.org 06 Nov '16

06 Nov '16

Nicolas Cellier uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-nice.1982.mcz ==================== Summary ==================== Name: VMMaker.oscog-nice.1982 Author: nice Time: 6 November 2016, 9:19:35.492542 pm UUID: ed988fdd-7019-41f8-9051-e08afa837953 Ancestors: VMMaker.oscog-nice.1981 Replace remaining long/unsigned long with sqIntptr_t/usqIntptr_t. Replace asLong/asUnsignedLong senders with asIntegerPtr/asUnsignedIntegerPtr. This should be essentially for those int containing a target machine pointer/address. For some printf cCode (used for debugging), the %ld does not work in LLP64. We use the standard C way for compatible 32 & 64bits code: use PRI_format_Type macros as the format (mainly PRIxSQPTR). This way, VMMaker is now LLP64 friendly. For other conventions (ILP32 and LP64), this does not change anything since sqIntptr_t is equivalent to long. =============== Diff against VMMaker.oscog-nice.1981 =============== Item was changed: ----- Method: BitBltSimulation>>rgbComponentAlpha32 (in category 'combination rules') ----- rgbComponentAlpha32 "This version assumes combinationRule = 41 sourcePixSize = destPixSize = 32 sourceForm ~= destForm. Note: The inner loop has been optimized for dealing with the special case of aR = aG = aB = 0 " | srcIndex dstIndex sourceWord srcAlpha destWord deltaX deltaY srcY dstY | <inline: false> "This particular method should be optimized in itself" "Give the compile a couple of hints" + <var: #deltaX type: 'register sqInt'> - <var: #deltaX type: 'register long'> <var: #sourceWord type: #'unsigned int'> <var: #destWord type: #'unsigned int'> "The following should be declared as pointers so the compiler will notice that they're used for accessing memory locations (good to know on an Intel architecture) but then the increments would be different between ST code and C code so must hope the compiler notices what happens (MS Visual C does)" + <var: #srcIndex type: 'register sqIntptr_t'> + <var: #dstIndex type: 'register sqIntptr_t'> - <var: #srcIndex type: 'register long'> - <var: #dstIndex type: 'register long'> deltaY := bbH + 1. "So we can pre-decrement" srcY := sy. dstY := dy. "This is the outer loop" [(deltaY := deltaY - 1) ~= 0] whileTrue:[ srcIndex := sourceBits + (srcY * sourcePitch) + (sx * 4). dstIndex := destBits + (dstY * destPitch) + (dx * 4). deltaX := bbW + 1. "So we can pre-decrement" "This is the inner loop" [(deltaX := deltaX - 1) ~= 0] whileTrue:[ sourceWord := self srcLongAt: srcIndex. srcAlpha := sourceWord bitAnd:16rFFFFFF. srcAlpha = 0 ifTrue:[ srcIndex := srcIndex + 4. dstIndex := dstIndex + 4. "Now skip as many words as possible," [(deltaX := deltaX - 1) ~= 0 and:[ ((sourceWord := self srcLongAt: srcIndex) bitAnd:16rFFFFFF) = 0]] whileTrue:[ srcIndex := srcIndex + 4. dstIndex := dstIndex + 4. ]. "Adjust deltaX" deltaX := deltaX + 1. ] ifFalse:[ "0 < srcAlpha" "If we have to mix colors then just copy a single word" destWord := self dstLongAt: dstIndex. destWord := self rgbComponentAlpha32: sourceWord with: destWord. self dstLongAt: dstIndex put: destWord. srcIndex := srcIndex + 4. dstIndex := dstIndex + 4. ]. ]. srcY := srcY + 1. dstY := dstY + 1. ].! Item was changed: ----- Method: CCodeGenerator>>returnTypeForSend:in:ifNil: (in category 'type inference') ----- returnTypeForSend: sendNode in: aTMethod ifNil: typeIfNil "Answer the return type for a send. Unbound sends default to typeIfNil. Methods with types as yet unknown have a type determined either by the kernelReturnTypes or the table below, or, if they are in neither set, then nil. The inferred type should match as closely as possible the C type of generated expessions so that inlining would not change the expression. If there is a method for sel but its return type is as yet unknown it mustn't be defaulted, since on a subsequent pass its type may be computable." | sel methodOrNil | methodOrNil := self anyMethodNamed: (sel := sendNode selector). (methodOrNil notNil and: [methodOrNil returnType notNil]) ifTrue: [^self baseTypeForType: methodOrNil returnType]. ^kernelReturnTypes at: sel ifAbsent: [sel caseOf: { [#integerValueOf:] -> [#sqInt]. [#isIntegerObject:] -> [#int]. [#negated] -> [self promoteArithmeticTypes: (self typeFor: sendNode receiver in: aTMethod) and: #int]. [#+] -> [self typeForArithmetic: sendNode in: aTMethod]. [#-] -> [self typeForArithmetic: sendNode in: aTMethod]. [#*] -> [self typeForArithmetic: sendNode in: aTMethod]. [#/] -> [self typeForArithmetic: sendNode in: aTMethod]. [#//] -> [self typeForArithmetic: sendNode in: aTMethod]. [#\\] -> [self typeForArithmetic: sendNode in: aTMethod]. [#rem:] -> [self typeForArithmetic: sendNode in: aTMethod]. [#quo:] -> [self typeForArithmetic: sendNode in: aTMethod]. "C99 Sec Bitwise shift operators ... 3 Sematics ... The integer promotions are performed on each of the operands. The type of the result is that of the promoted left operand..." [#>>] -> [self typeFor: sendNode receiver in: aTMethod]. [#<<] -> [self typeFor: sendNode receiver in: aTMethod]. [#addressOf:] -> [(self typeFor: sendNode receiver in: aTMethod) ifNil: [#sqInt] ifNotNil: [:type| type, (type last isLetter ifTrue: [' *'] ifFalse: ['*'])]]. [#at:] -> [self typeForDereference: sendNode in: aTMethod]. [#bitAnd:] -> [self typeForArithmetic: sendNode in: aTMethod]. [#bitOr:] -> [self typeForArithmetic: sendNode in: aTMethod]. [#bitXor:] -> [self typeForArithmetic: sendNode in: aTMethod]. [#bitClear:] -> [self typeForArithmetic: sendNode in: aTMethod]. [#bitInvert32] -> [#'unsigned int']. [#bitInvert64] -> [self promoteArithmeticTypes: (self typeFor: sendNode receiver in: aTMethod) and: #int]. [#byteSwap32] -> [#'unsigned int']. [#byteSwap64] -> [#'unsigned long long']. [#byteSwapped32IfBigEndian:] -> [#'unsigned int']. [#byteSwapped64IfBigEndian:] -> [#'unsigned long long']. [#=] -> [#int]. [#~=] -> [#int]. [#==] -> [#int]. [#~~] -> [#int]. [#<] -> [#int]. [#<=] -> [#int]. [#>] -> [#int]. [#>=] -> [#int]. [#between:and:] -> [#int]. [#anyMask:] -> [#int]. [#allMask:] -> [#int]. [#noMask:] -> [#int]. [#isNil] -> [#int]. [#notNil] -> [#int]. [#&] -> [#int]. [#|] -> [#int]. [#not] -> [#int]. [#asFloat] -> [#double]. [#atan] -> [#double]. [#exp] -> [#double]. [#log] -> [#double]. [#sin] -> [#double]. [#sqrt] -> [#double]. [#asLong] -> [#long]. [#asInteger] -> [#sqInt]. [#asIntegerPtr] -> [#'sqIntptr_t']. [#asUnsignedInteger] -> [#usqInt]. [#asUnsignedIntegerPtr]-> [#'usqIntptr_t']. [#asUnsignedLong] -> [#'unsigned long']. [#asUnsignedLongLong] -> [#'unsigned long long']. [#asVoidPointer] -> [#'void *']. [#signedIntToLong] -> [#usqInt]. "c.f. generateSignedIntToLong:on:indent:" [#signedIntToShort] -> [#usqInt]. "c.f. generateSignedIntToShort:on:indent:" [#cCoerce:to:] -> [sendNode args last value]. [#cCoerceSimple:to:] -> [sendNode args last value]. + [#sizeof:] -> [#'usqIntptr_t']. "Technically it's a size_t but it matches on target architectures so far..." - [#sizeof:] -> [#'unsigned long']. "Technically it's a size_t but it matches unsigned long on target architectures so far..." [#ifTrue:ifFalse:] -> [self typeForConditional: sendNode in: aTMethod]. [#ifFalse:ifTrue:] -> [self typeForConditional: sendNode in: aTMethod]. [#ifTrue:] -> [self typeForConditional: sendNode in: aTMethod]. [#ifFalse:] -> [self typeForConditional: sendNode in: aTMethod]. [#and:] -> [#sqInt]. [#or:] -> [#sqInt] } otherwise: "If there /is/ a method for sel but its return type is as yet unknown it /mustn't/ be defaulted, since on a subsequent pass its type may be computable. Only default unbound selectors." [methodOrNil ifNotNil: [nil] ifNil: [typeIfNil]]]! Item was changed: ----- Method: ClipboardExtendedPlugin>>ioAddClipboardData:data:dataFormat: (in category 'io') ----- ioAddClipboardData: clipboard data: data dataFormat: aFormat | clipboardAddress formatLength dataLength | + <var: #clipboardAddress type: #'usqIntptr_t'> - <var: #clipboardAddress type: #'unsigned long'> self primitive: 'ioAddClipboardData' parameters: #(Oop ByteArray String). clipboardAddress := interpreterProxy positiveMachineIntegerValueOf: clipboard. dataLength := interpreterProxy slotSizeOf: data cPtrAsOop. formatLength := interpreterProxy slotSizeOf: aFormat cPtrAsOop. self sqPasteboardPutItemFlavor: clipboardAddress data: data length: dataLength formatType: aFormat formatLength: formatLength. ! Item was changed: ----- Method: ClipboardExtendedPlugin>>ioClearClipboard: (in category 'io') ----- ioClearClipboard: clipboard | clipboardAddress | + <var: #clipboardAddress type: #'usqIntptr_t'> - <var: #clipboardAddress type: #'unsigned long'> self primitive: 'ioClearClipboard' parameters: #(Oop). clipboardAddress := interpreterProxy positiveMachineIntegerValueOf: clipboard. self sqPasteboardClear: clipboardAddress.! Item was changed: ----- Method: ClipboardExtendedPlugin>>ioGetClipboardFormat:formatNumber: (in category 'io') ----- ioGetClipboardFormat: clipboard formatNumber: formatNumber | clipboardAddress itemCount | + <var: #clipboardAddress type: #'usqIntptr_t'> - <var: #clipboardAddress type: #'unsigned long'> self primitive: 'ioGetClipboardFormat' parameters: #(#Oop #SmallInteger ). clipboardAddress := interpreterProxy positiveMachineIntegerValueOf: clipboard. itemCount := self sqPasteboardGetItemCount: clipboardAddress. itemCount > 0 ifTrue: [^ self sqPasteboardCopyItemFlavors: clipboardAddress itemNumber: formatNumber]. ^ interpreterProxy nilObject! Item was changed: ----- Method: ClipboardExtendedPlugin>>ioReadClipboardData:format: (in category 'io') ----- ioReadClipboardData: clipboard format: format | clipboardAddress formatLength | + <var: #clipboardAddress type: #'usqIntptr_t'> - <var: #clipboardAddress type: #'unsigned long'> self primitive: 'ioReadClipboardData' parameters: #(Oop String). clipboardAddress := interpreterProxy positiveMachineIntegerValueOf: clipboard. formatLength := interpreterProxy slotSizeOf: format cPtrAsOop. ^ self sqPasteboardCopyItemFlavorData: clipboardAddress format: format formatLength: formatLength. ! Item was changed: ----- Method: CoInterpreter>>printMethodCacheFor: (in category 'debug printing') ----- printMethodCacheFor: thing <api> | n | n := 0. 0 to: MethodCacheSize - 1 by: MethodCacheEntrySize do: [:i | | s c m p | s := methodCache at: i + MethodCacheSelector. c := methodCache at: i + MethodCacheClass. m := methodCache at: i + MethodCacheMethod. p := methodCache at: i + MethodCachePrimFunction. ((thing = -1 or: [s = thing or: [c = thing or: [p = thing or: [m = thing or: [(objectMemory addressCouldBeObj: m) and: [(self maybeMethodHasCogMethod: m) and: [(self cogMethodOf: m) asInteger = thing]]]]]]]) and: [(objectMemory addressCouldBeOop: s) and: [c ~= 0 and: [(self addressCouldBeClassObj: c) or: [self addressCouldBeClassObj: (objectMemory classForClassTag: c)]]]]) ifTrue: [n := n + 1. self cCode: [] inSmalltalk: [self transcript ensureCr]. self printNum: i; space; printHexnp: i; cr; tab. (objectMemory isBytesNonImm: s) + ifTrue: [self cCode: 'printf("%" PRIxSQPTR " %.*s\n", s, (int)(numBytesOf(s)), (char *)firstIndexableField(s))' - ifTrue: [self cCode: 'printf("%lx %.*s\n", s, (int)(numBytesOf(s)), (char *)firstIndexableField(s))' inSmalltalk: [self printHex: s; space; print: (self stringOf: s); cr]] ifFalse: [self shortPrintOop: s]. self tab. (self addressCouldBeClassObj: c) ifTrue: [self shortPrintOop: c] ifFalse: [self printNum: c; space; printHexnp: c; space; shortPrintOop: (objectMemory classForClassTag: c)]. self tab; shortPrintOop: m; tab. self cCode: [p > 1024 ifTrue: [self printHexnp: p] ifFalse: [self printNum: p]] inSmalltalk: [p isSymbol ifTrue: [self print: p] ifFalse: [self printNum: p]]. self cr]]. n > 1 ifTrue: [self printNum: n; cr]! Item was changed: ----- Method: CoInterpreter>>rewriteMethodCacheEntryForExternalPrimitiveToFunction: (in category 'method lookup cache') ----- rewriteMethodCacheEntryForExternalPrimitiveToFunction: localPrimAddress "Rewrite an existing entry in the method cache with a new primitive function address. Used by primitiveExternalCall to make direct calls to found external prims, or quickly fail not found external prims. Override to do the same to the machine code call. If methodObj has a cogged dual rewrite the primitive call in it to call localPrimAddress. Used to update calls through primitiveExternalCall to directly call the target function or to revert to calling primitiveExternalCall after a flush." <var: #localPrimAddress declareC: 'void (*localPrimAddress)(void)'> <inline: false> (self methodHasCogMethod: newMethod) ifTrue: [cogit rewritePrimInvocationIn: (self cogMethodOf: newMethod) to: (localPrimAddress = 0 ifTrue: [self cCoerceSimple: #primitiveFail to: #'void (*)(void)'] ifFalse: [localPrimAddress])]. (methodCache at: lastMethodCacheProbeWrite + MethodCacheMethod) = newMethod ifTrue: [methodCache at: lastMethodCacheProbeWrite + MethodCachePrimFunction + put: (self cCoerce: localPrimAddress to: #'sqIntptr_t')]! - put: (self cCoerce: localPrimAddress to: #long)]! Item was changed: ----- Method: CogARMCompiler class>>machineCodeDeclaration (in category 'translation') ----- machineCodeDeclaration "Answer the declaration for the machineCode array." + ^{#'usqIntptr_t'. '[', self basicNew machineCodeWords printString, ']'}! - ^{#'unsigned long'. '[', self basicNew machineCodeWords printString, ']'}! Item was changed: ----- Method: CogARMCompiler>>isInImmediateJumpRange: (in category 'testing') ----- isInImmediateJumpRange: operand "ARM calls and jumps span +/- 32 mb, more than enough for intra-zone calls and jumps." + <var: #operand type: #'usqIntptr_t'> - <var: #operand type: #'unsigned long'> ^operand signedIntFromLong between: -16r2000000 and: 16r1FFFFFC! Item was changed: ----- Method: CogAbstractInstruction class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') ----- instVarNamesAndTypesForTranslationDo: aBinaryBlock "enumerate aBinaryBlock with the names and C type strings for the inst vars to include in an AbstractInstruction struct." "{CogAbstractInstruction. CogIA32Compiler. CogARMCompiler} do: [:c| Transcript print: c; cr. c printTypedefOn: Transcript]" (self filteredInstVarNames copyWithout: 'machineCode'), #('machineCode') do: [:ivn| ivn ~= 'bcpc' ifTrue: [aBinaryBlock value: ivn value: (ivn caseOf: { + ['address'] -> [#'usqIntptr_t']. - ['address'] -> [#'unsigned long']. ['machineCode'] -> [self machineCodeDeclaration]. + ['operands'] -> [{#'usqIntptr_t'. '[', NumOperands, ']'}]. - ['operands'] -> [{#'unsigned long'. '[', NumOperands, ']'}]. ['dependent'] -> ['struct _AbstractInstruction *']} otherwise: [#'unsigned char'])]]! Item was changed: ----- Method: CogMIPSELCompiler class>>machineCodeDeclaration (in category 'translation') ----- machineCodeDeclaration "Answer the declaration for the machineCode array." + ^{#'usqIntptr_t'. '[', self basicNew machineCodeWords printString, ']'}! - ^{#'unsigned long'. '[', self basicNew machineCodeWords printString, ']'}! Item was changed: ----- Method: CogMethodZone>>roundUpAddress: (in category 'accessing') ----- roundUpAddress: address <returnTypeC: #'void *'> <var: #address type: #'void *'> + ^self cCoerce: ((self cCoerce: address to: #'usqIntptr_t') + 7 bitAnd: -8) to: #'void *'! - ^self cCoerce: ((self cCoerce: address to: 'unsigned long') + 7 bitAnd: -8) to: #'void *'! Item was changed: ----- Method: CogVMSimulator>>rewriteMethodCacheEntryForExternalPrimitiveToFunction: (in category 'method lookup cache') ----- rewriteMethodCacheEntryForExternalPrimitiveToFunction: localPrimAddress super rewriteMethodCacheEntryForExternalPrimitiveToFunction: (self mapFunctionToAddress: (localPrimAddress = 0 ifTrue: [#primitiveFail] ifFalse: [localPrimAddress])). "Hack; the super call will rewrite the entry to the address of the function. So (when simulating) undo the damage and put back the functionPointer" (methodCache at: lastMethodCacheProbeWrite + MethodCacheMethod) = newMethod ifTrue: [methodCache at: lastMethodCacheProbeWrite + MethodCachePrimFunction + put: (self cCoerce: localPrimAddress to: #'sqIntptr_t')]! - put: (self cCoerce: localPrimAddress to: #long)]! Item was changed: ----- Method: CogX64Compiler>>isQuick: (in category 'testing') ----- isQuick: operand + <var: #operand type: #'usqIntptr_t'> - <var: #operand type: #'unsigned long'> ^operand signedIntFromLong64 between: -128 and: 127! Item was changed: ----- Method: Cogit class>>declareCVarsIn: (in category 'translation') ----- declareCVarsIn: aCCodeGenerator #( 'coInterpreter' 'objectMemory' 'methodZone' 'objectRepresentation' 'cogBlockMethodSurrogateClass' 'cogMethodSurrogateClass' 'nsSendCacheSurrogateClass' 'threadManager' 'processor' 'lastNInstructions' 'simulatedAddresses' 'simulatedTrampolines' 'simulatedVariableGetters' 'simulatedVariableSetters' 'printRegisters' 'printInstructions' 'clickConfirm' 'singleStep') do: [:simulationVariableNotNeededForRealVM| aCCodeGenerator removeVariable: simulationVariableNotNeededForRealVM]. NewspeakVM ifFalse: [#( 'selfSendTrampolines' 'dynamicSuperSendTrampolines' 'implicitReceiverSendTrampolines' 'outerSendTrampolines' 'ceEnclosingObjectTrampoline' 'numIRCs' 'indexOfIRC' 'theIRCs') do: [:variableNotNeededInNormalVM| aCCodeGenerator removeVariable: variableNotNeededInNormalVM]]. aCCodeGenerator removeConstant: #COGMTVM. "this should be defined at compile time" aCCodeGenerator addHeaderFile:'<stddef.h>'; "for e.g. offsetof" addHeaderFile:'"sqCogStackAlignment.h"'; addHeaderFile:'"dispdbg.h"'; "must precede cointerp.h & cogit.h otherwise NoDbgRegParms gets screwed up" addHeaderFile:'"cogmethod.h"'. NewspeakVM ifTrue: [aCCodeGenerator addHeaderFile:'"nssendcache.h"']. aCCodeGenerator addHeaderFile:'#if COGMTVM'; addHeaderFile:'"cointerpmt.h"'; addHeaderFile:'#else'; addHeaderFile:'"cointerp.h"'; addHeaderFile:'#endif'; addHeaderFile:'"cogit.h"'. aCCodeGenerator var: #ceGetFP + declareC: 'usqIntptr_t (*ceGetFP)(void)'; - declareC: 'unsigned long (*ceGetFP)(void)'; var: #ceGetSP + declareC: 'usqIntptr_t (*ceGetSP)(void)'; - declareC: 'unsigned long (*ceGetSP)(void)'; var: #ceCaptureCStackPointers declareC: 'void (*ceCaptureCStackPointers)(void)'; var: #ceEnterCogCodePopReceiverReg declareC: 'void (*ceEnterCogCodePopReceiverReg)(void)'; var: #realCEEnterCogCodePopReceiverReg declareC: 'void (*realCEEnterCogCodePopReceiverReg)(void)'; var: #ceCallCogCodePopReceiverReg declareC: 'void (*ceCallCogCodePopReceiverReg)(void)'; var: #realCECallCogCodePopReceiverReg declareC: 'void (*realCECallCogCodePopReceiverReg)(void)'; var: #ceCallCogCodePopReceiverAndClassRegs declareC: 'void (*ceCallCogCodePopReceiverAndClassRegs)(void)'; var: #realCECallCogCodePopReceiverAndClassRegs declareC: 'void (*realCECallCogCodePopReceiverAndClassRegs)(void)'; var: #ceFlushICache + declareC: 'static void (*ceFlushICache)(usqIntptr_t from, usqIntptr_t to)'; - declareC: 'static void (*ceFlushICache)(unsigned long from, unsigned long to)'; var: #ceCheckFeaturesFunction + declareC: 'static usqIntptr_t (*ceCheckFeaturesFunction)(void)'; - declareC: 'static unsigned long (*ceCheckFeaturesFunction)(void)'; var: #ceTryLockVMOwner + declareC: 'usqIntptr_t (*ceTryLockVMOwner)(void)'; - declareC: 'unsigned long (*ceTryLockVMOwner)(void)'; var: #ceUnlockVMOwner declareC: 'void (*ceUnlockVMOwner)(void)'; var: #postCompileHook declareC: 'void (*postCompileHook)(CogMethod *)'; var: #openPICList declareC: 'CogMethod *openPICList = 0'; var: #maxMethodBefore type: #'CogBlockMethod *'; var: 'enumeratingCogMethod' type: #'CogMethod *'. aCCodeGenerator declareVar: 'aMethodLabel' type: #'AbstractInstruction'; "Has to come lexicographically before backEnd & methodLabel" var: #backEnd declareC: 'AbstractInstruction * const backEnd = &aMethodLabel'; var: #methodLabel declareC: 'AbstractInstruction * const methodLabel = &aMethodLabel'. self declareC: #(abstractOpcodes stackCheckLabel blockEntryLabel blockEntryNoContextSwitch stackOverflowCall sendMiss entry noCheckEntry selfSendEntry dynSuperEntry fullBlockNoContextSwitchEntry fullBlockEntry picMNUAbort picInterpretAbort endCPICCase0 endCPICCase1 cPICEndOfCodeLabel) as: #'AbstractInstruction *' in: aCCodeGenerator. aCCodeGenerator declareVar: #blockStarts type: #'BlockStart *'; declareVar: #fixups type: #'BytecodeFixup *'. aCCodeGenerator var: #ordinarySendTrampolines declareC: 'sqInt ordinarySendTrampolines[NumSendTrampolines]'; var: #superSendTrampolines declareC: 'sqInt superSendTrampolines[NumSendTrampolines]'; var: #directedSuperSendTrampolines declareC: 'sqInt directedSuperSendTrampolines[NumSendTrampolines]'; var: #selfSendTrampolines declareC: 'sqInt selfSendTrampolines[NumSendTrampolines]'; var: #dynamicSuperSendTrampolines declareC: 'sqInt dynamicSuperSendTrampolines[NumSendTrampolines]'; var: #implicitReceiverSendTrampolines declareC: 'sqInt implicitReceiverSendTrampolines[NumSendTrampolines]'; var: #outerSendTrampolines declareC: 'sqInt outerSendTrampolines[NumSendTrampolines]'; var: #trampolineAddresses declareC: 'static char *trampolineAddresses[NumTrampolines*2]'; var: #objectReferencesInRuntime declareC: 'static usqInt objectReferencesInRuntime[NumObjRefsInRuntime]'; var: #labelCounter type: #int; var: #traceFlags declareC: 'int traceFlags = 8 /* prim trace log on by default */'; var: #cStackAlignment declareC: 'const int cStackAlignment = STACK_ALIGN_BYTES'. aCCodeGenerator declareVar: #CFramePointer type: #'void *'; declareVar: #CStackPointer type: #'void *'; + declareVar: #minValidCallAddress type: #'usqIntptr_t'; + declareVar: #debugPrimCallStackOffset type: #'usqIntptr_t'. - declareVar: #minValidCallAddress type: #'unsigned long'; - declareVar: #debugPrimCallStackOffset type: #'unsigned long'. aCCodeGenerator vmClass generatorTable ifNotNil: [:bytecodeGenTable| aCCodeGenerator var: #generatorTable declareC: 'static BytecodeDescriptor generatorTable[', bytecodeGenTable size, ']', (self tableInitializerFor: bytecodeGenTable in: aCCodeGenerator)]. "In C the abstract opcode names clash with the Smalltak generator syntactic sugar. Most of the syntactic sugar is inlined, but alas some remains. Rename the syntactic sugar to avoid the clash." (self organization listAtCategoryNamed: #'abstract instructions') do: [:s| aCCodeGenerator addSelectorTranslation: s to: 'g', (aCCodeGenerator cFunctionNameFor: s)]. aCCodeGenerator addSelectorTranslation: #halt: to: 'haltmsg'! Item was changed: ----- Method: Cogit>>cFramePointerAddress (in category 'trampoline support') ----- cFramePointerAddress + <cmacro: '() ((usqIntptr_t)&CFramePointer)'> - <cmacro: '() ((unsigned long)&CFramePointer)'> ^(backEnd wantsNearAddressFor: #CFramePointer) ifTrue: [self simulatedReadWriteVariableAddress: #getCFramePointer in: self] ifFalse: [coInterpreter inMemoryCFramePointerAddress]! Item was changed: ----- Method: Cogit>>cStackPointerAddress (in category 'trampoline support') ----- cStackPointerAddress + <cmacro: '() ((usqIntptr_t)&CStackPointer)'> - <cmacro: '() ((unsigned long)&CStackPointer)'> ^(backEnd wantsNearAddressFor: #CStackPointer) ifTrue: [self simulatedReadWriteVariableAddress: #getCStackPointer in: self] ifFalse: [coInterpreter inMemoryCStackPointerAddress]! Item was changed: ----- Method: Cogit>>genGetLeafCallStackPointer (in category 'initialization') ----- genGetLeafCallStackPointer "Generate a routine that answers the stack pointer immedately after a leaf call, used for checking stack pointer alignment." | startAddress | <inline: false> self allocateOpcodes: 4 bytecodes: 0. startAddress := methodZoneBase. self MoveR: FPReg R: backEnd cResultRegister; RetN: 0. self outputInstructionsForGeneratedRuntimeAt: startAddress. self recordGeneratedRunTime: 'ceGetFP' address: startAddress. + ceGetFP := self cCoerceSimple: startAddress to: #'usqIntptr_t (*)(void)'. - ceGetFP := self cCoerceSimple: startAddress to: #'unsigned long (*)(void)'. startAddress := methodZoneBase. self zeroOpcodeIndex. self MoveR: SPReg R: backEnd cResultRegister. backEnd leafCallStackPointerDelta ~= 0 ifTrue: [self AddCq: backEnd leafCallStackPointerDelta R: backEnd cResultRegister]. self RetN: 0. self outputInstructionsForGeneratedRuntimeAt: startAddress. self recordGeneratedRunTime: 'ceGetSP' address: startAddress. + ceGetSP := self cCoerceSimple: startAddress to: #'usqIntptr_t (*)(void)'! - ceGetSP := self cCoerceSimple: startAddress to: #'unsigned long (*)(void)'! Item was changed: ----- Method: Cogit>>generateVMOwnerLockFunctions (in category 'initialization') ----- generateVMOwnerLockFunctions | startAddress | <inline: true> self cppIf: COGMTVM ifTrue: [self allocateOpcodes: backEnd numLowLevelLockOpcodes bytecodes: 0. self zeroOpcodeIndex. startAddress := methodZoneBase. backEnd generateLowLevelTryLock: coInterpreter vmOwnerLockAddress. self outputInstructionsForGeneratedRuntimeAt: startAddress. self recordGeneratedRunTime: 'ceTryLockVMOwner' address: startAddress. + ceTryLockVMOwner := self cCoerceSimple: startAddress to: #'usqIntptr_t (*)(void)'. - ceTryLockVMOwner := self cCoerceSimple: startAddress to: #'unsigned long (*)(void)'. self zeroOpcodeIndex. initialPC := 0. endPC := numAbstractOpcodes - 1. startAddress := methodZoneBase. backEnd generateLowLevelUnlock: coInterpreter vmOwnerLockAddress. self outputInstructionsForGeneratedRuntimeAt: startAddress. self recordGeneratedRunTime: 'ceUnlockVMOwner' address: startAddress. ceUnlockVMOwner := self cCoerceSimple: startAddress to: #'void (*)(void)']! Item was changed: ----- Method: Cogit>>maybeGenerateCheckFeatures (in category 'initialization') ----- maybeGenerateCheckFeatures | startAddress | <inline: true> backEnd numCheckFeaturesOpcodes > 0 ifTrue: [self allocateOpcodes: backEnd numCheckFeaturesOpcodes bytecodes: 0. startAddress := methodZoneBase. backEnd generateCheckFeatures. self outputInstructionsForGeneratedRuntimeAt: startAddress. self recordGeneratedRunTime: 'ceCheckFeaturesFunction' address: startAddress. + ceCheckFeaturesFunction := self cCoerceSimple: startAddress to: #'usqIntptr_t (*)(void)']! - ceCheckFeaturesFunction := self cCoerceSimple: startAddress to: #'unsigned long (*)(void)']! Item was changed: ----- Method: Cogit>>maybeGenerateICacheFlush (in category 'initialization') ----- maybeGenerateICacheFlush | startAddress | <inline: true> backEnd numICacheFlushOpcodes > 0 ifTrue: [self allocateOpcodes: backEnd numICacheFlushOpcodes bytecodes: 0. startAddress := methodZoneBase. backEnd generateICacheFlush. self outputInstructionsForGeneratedRuntimeAt: startAddress. self recordGeneratedRunTime: 'ceFlushICache' address: startAddress. + ceFlushICache := self cCoerceSimple: startAddress to: #'void (*)(usqIntptr_t,usqIntptr_t)']! - ceFlushICache := self cCoerceSimple: startAddress to: #'void (*)(unsigned long,unsigned long)']! Item was changed: ----- Method: Cogit>>positiveMachineIntegerFor: (in category 'profiling primitives') ----- positiveMachineIntegerFor: value + <var: #value type: #'usqIntptr_t'> - <var: #value type: #'unsigned long'> <inline: true> ^objectMemory wordSize = 8 ifTrue: [coInterpreter positive64BitIntegerFor: value] ifFalse: [coInterpreter positive32BitIntegerFor: value]! Item was changed: ----- Method: IA32ABIPlugin>>primAllocateExecutablePage (in category 'primitives-memory management') ----- primAllocateExecutablePage "Answer an Alien for an executable page; for thunks" "primAllocateExecutablePage ^<Alien> <primitive: 'primAllocateExecutablePage' error: errorCode module: 'IA32ABI'>" | byteSize ptr mem alien | <export: true> + <var: #byteSize type: #'sqIntptr_t'> + <var: #ptr type: #'sqIntptr_t *'> + <var: #mem type: #'void *'> - <var: #byteSize type: 'long'> - <var: #ptr type: 'long *'> - <var: #mem type: 'void *'> self cCode: 'mem = allocateExecutablePage(&byteSize)' inSmalltalk: [self error: 'not yet implemented'. mem := 0. byteSize := 0]. mem = 0 ifTrue: [^interpreterProxy primitiveFailFor: PrimErrNoCMemory]. alien := interpreterProxy instantiateClass: interpreterProxy classAlien indexableSize: 2 * interpreterProxy bytesPerOop. interpreterProxy failed ifTrue: [^interpreterProxy primitiveFailFor: PrimErrNoMemory]. ptr := interpreterProxy firstIndexableField: alien. ptr at: 0 put: 0 - byteSize. "indirect mem indicated by negative size. Slang doesn't grok negated" + ptr at: 1 put: (self cCoerce: mem to: #'sqIntptr_t'). - ptr at: 1 put: (self cCoerce: mem to: 'long'). interpreterProxy methodReturnValue: alien! Item was changed: ----- Method: IA32ABIPlugin>>primBoxedFree (in category 'primitives-memory management') ----- primBoxedFree "Free the memory referenced by the receiver, an Alien." "proxy <Alien> primFree ^<Alien> <primitive: 'primBoxedFree' error: errorCode module: 'IA32ABI'>" | addr rcvr ptr sizeField | <export: true> + <var: #ptr type: #'sqIntptr_t *'> + <var: #addr type: #'sqIntptr_t'> + <var: #sizeField type: #'sqIntptr_t'> - <var: #ptr type: 'sqInt *'> - <var: #sizeField type: 'long'> rcvr := interpreterProxy stackValue: 0. (interpreterProxy byteSizeOf: rcvr) >= (2 * interpreterProxy bytesPerOop) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadReceiver]. ptr := interpreterProxy firstIndexableField: rcvr. sizeField := ptr at: 0. addr := ptr at: 1. "Don't you dare to free Squeak's memory!!" (sizeField >= 0 or: [addr = 0 or: [interpreterProxy isInMemory: addr]]) ifTrue: [^interpreterProxy primitiveFailFor: PrimErrInappropriate]. self cCode: 'free((void *)addr)' inSmalltalk: [self Cfree: addr]. ptr at: 0 put: 0; at: 1 put: 0 "cleanup"! Item was changed: ----- Method: IA32ABIPlugin>>primThunkEntryAddress (in category 'primitives-callbacks') ----- primThunkEntryAddress "Answer the address of the entry-point for thunk callbacks: long thunkEntry(void *thunkp, long *stackp); This could be derived via loadModule: findSymbol: etc but that would preclude making the plugin internal." | address | <export: true> + address := self cCode: [#thunkEntry asIntegerPtr] inSmalltalk: [0]. - address := self cCode: [#thunkEntry asInteger] inSmalltalk: [0]. interpreterProxy methodReturnValue: (self positiveMachineIntegerFor: address)! Item was changed: ----- Method: Interpreter class>>declareCVarsIn: (in category 'translation') ----- declareCVarsIn: aCCodeGenerator aCCodeGenerator addHeaderFile:'<setjmp.h>'. self declareInterpreterVersionIn: aCCodeGenerator defaultName: 'Context'. aCCodeGenerator var: #interpreterProxy type: #'struct VirtualMachine*'. aCCodeGenerator var: #primitiveTable declareC: 'void *primitiveTable[MaxPrimitiveIndex + 2 /* ', (MaxPrimitiveIndex +2) printString, ' */] = ', self primitiveTableString. aCCodeGenerator var: #primitiveFunctionPointer declareC: 'void *primitiveFunctionPointer'. "xxxx FIX THIS STUPIDITY xxxx - ikp. What he means is use a better type than void *, apparently - tpr" aCCodeGenerator var: #methodCache + declareC: 'sqIntptr_t methodCache[MethodCacheSize + 1 /* ', (MethodCacheSize + 1) printString, ' */]'. - declareC: 'long methodCache[MethodCacheSize + 1 /* ', (MethodCacheSize + 1) printString, ' */]'. aCCodeGenerator var: #atCache declareC: 'sqInt atCache[AtCacheTotalSize + 1 /* ', (AtCacheTotalSize + 1) printString, ' */]'. aCCodeGenerator var: #localIP type: #'char*'. aCCodeGenerator var: #localSP type: #'char*'. aCCodeGenerator var: #showSurfaceFn type: #'void*'. aCCodeGenerator var: 'semaphoresToSignalA' declareC: 'sqInt semaphoresToSignalA[SemaphoresToSignalSize + 1 /* ', (SemaphoresToSignalSize + 1) printString, ' */]'. aCCodeGenerator var: 'semaphoresToSignalB' declareC: 'sqInt semaphoresToSignalB[SemaphoresToSignalSize + 1 /* ', (SemaphoresToSignalSize + 1) printString, ' */]'. aCCodeGenerator var: #compilerHooks declareC: 'sqInt (*compilerHooks[CompilerHooksSize + 1 /* ', (CompilerHooksSize + 1) printString, ' */])()'. aCCodeGenerator var: #externalPrimitiveTable declareC: 'void *externalPrimitiveTable[MaxExternalPrimitiveTableSize + 1 /* ', (MaxExternalPrimitiveTableSize + 1) printString, ' */]'. aCCodeGenerator var: #jmpBuf declareC: 'jmp_buf jmpBuf[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'. aCCodeGenerator var: #suspendedCallbacks declareC: 'usqInt suspendedCallbacks[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'. aCCodeGenerator var: #suspendedMethods declareC: 'usqInt suspendedMethods[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'. self declareCAsOop: { #instructionPointer. #method. #newMethod. #activeContext. #theHomeContext. #stackPointer } in: aCCodeGenerator. aCCodeGenerator var: #nextProfileTick type: #sqLong. ! Item was changed: ----- Method: Interpreter>>addNewMethodToCache (in category 'method lookup cache') ----- addNewMethodToCache "Add the given entry to the method cache. The policy is as follows: Look for an empty entry anywhere in the reprobe chain. If found, install the new entry there. If not found, then install the new entry at the first probe position and delete the entries in the rest of the reprobe chain. This has two useful purposes: If there is active contention over the first slot, the second or third will likely be free for reentry after ejection. Also, flushing is good when reprobe chains are getting full." | probe hash | <inline: false> hash := messageSelector bitXor: lkupClass. "drop low-order zeros from addresses" (self isOopCompiledMethod: newMethod) ifTrue: [primitiveIndex := self primitiveIndexOf: newMethod. primitiveFunctionPointer := self functionPointerFor: primitiveIndex inClass: lkupClass] ifFalse: [primitiveFunctionPointer := #primitiveInvokeObjectAsMethod]. primitiveFunctionPointer := self functionPointerFor: primitiveIndex inClass: lkupClass. 0 to: CacheProbeMax-1 do: [:p | probe := (hash >> p) bitAnd: MethodCacheMask. (methodCache at: probe + MethodCacheSelector) = 0 ifTrue: ["Found an empty entry -- use it" methodCache at: probe + MethodCacheSelector put: messageSelector. methodCache at: probe + MethodCacheClass put: lkupClass. methodCache at: probe + MethodCacheMethod put: newMethod. methodCache at: probe + MethodCachePrim put: primitiveIndex. + methodCache at: probe + MethodCachePrimFunction put: (self cCoerce: primitiveFunctionPointer to: #'sqIntptr_t'). - methodCache at: probe + MethodCachePrimFunction put: (self cCoerce: primitiveFunctionPointer to: 'long'). ^ nil]]. "OK, we failed to find an entry -- install at the first slot..." probe := hash bitAnd: MethodCacheMask. "first probe" methodCache at: probe + MethodCacheSelector put: messageSelector. methodCache at: probe + MethodCacheClass put: lkupClass. methodCache at: probe + MethodCacheMethod put: newMethod. methodCache at: probe + MethodCachePrim put: primitiveIndex. + methodCache at: probe + MethodCachePrimFunction put: (self cCoerce: primitiveFunctionPointer to: #'sqIntptr_t'). - methodCache at: probe + MethodCachePrimFunction put: (self cCoerce: primitiveFunctionPointer to: 'long'). "...and zap the following entries" 1 to: CacheProbeMax-1 do: [:p | probe := (hash >> p) bitAnd: MethodCacheMask. methodCache at: probe + MethodCacheSelector put: 0]. ! Item was changed: ----- Method: Interpreter>>rewriteMethodCacheSel:class:primIndex:primFunction: (in category 'method lookup cache') ----- rewriteMethodCacheSel: selector class: class primIndex: localPrimIndex primFunction: localPrimAddress "Rewrite an existing entry in the method cache with a new primitive index & function address. Used by primExternalCall to make direct jumps to found external prims" | probe hash | <inline: false> <var: #localPrimAddress type: 'void *'> hash := selector bitXor: class. 0 to: CacheProbeMax - 1 do: [:p | probe := hash >> p bitAnd: MethodCacheMask. ((methodCache at: probe + MethodCacheSelector) = selector and: [(methodCache at: probe + MethodCacheClass) = class]) ifTrue: [methodCache at: probe + MethodCachePrim put: localPrimIndex. + methodCache at: probe + MethodCachePrimFunction put: (self cCoerce: localPrimAddress to: #'sqIntptr_t'). - methodCache at: probe + MethodCachePrimFunction put: (self cCoerce: localPrimAddress to: 'long'). ^ nil]]! Item was changed: ----- Method: InterpreterPlugin>>positiveMachineIntegerFor: (in category 'API access') ----- positiveMachineIntegerFor: value + <var: #value type: #'usqIntptr_t'> - <var: #value type: #'unsigned long'> <inline: true> ^interpreterProxy wordSize = 8 ifTrue: [interpreterProxy positive64BitIntegerFor: value] ifFalse: [interpreterProxy positive32BitIntegerFor: value]! Item was changed: ----- Method: InterpreterPlugin>>signedMachineIntegerFor: (in category 'API access') ----- signedMachineIntegerFor: value + <var: #value type: #'sqIntptr_t'> - <var: #value type: #'unsigned long'> <inline: true> ^interpreterProxy wordSize = 8 ifTrue: [interpreterProxy signed64BitIntegerFor: value] ifFalse: [interpreterProxy signed32BitIntegerFor: value]! Item was changed: ----- Method: InterpreterPrimitives>>positiveMachineIntegerValueOf: (in category 'primitive support') ----- positiveMachineIntegerValueOf: oop "Answer a value of an integer in address range, i.e up to the size of a machine word. The object may be either a positive SmallInteger or a LargePositiveInteger of size <= word size." + <returnTypeC: #'usqIntptr_t'> - <returnTypeC: #'unsigned long'> <inline: true> "only two callers & one is primitiveNewWithArg" | value bs ok | (objectMemory isIntegerObject: oop) ifTrue: [value := objectMemory integerValueOf: oop. value < 0 ifTrue: [^self primitiveFail]. ^value]. (objectMemory isNonIntegerImmediate: oop) ifTrue: [self primitiveFail. ^0]. ok := objectMemory isClassOfNonImm: oop equalTo: (objectMemory splObj: ClassLargePositiveInteger) compactClassIndex: ClassLargePositiveIntegerCompactIndex. ok ifFalse: [self primitiveFail. ^0]. bs := objectMemory numBytesOfBytes: oop. + bs > (self sizeof: #'usqIntptr_t') ifTrue: - bs > (self sizeof: #'unsigned long') ifTrue: [self primitiveFail. ^0]. "self cppIf: SPURVM ifTrue: [""Memory is 8 byte aligned in Spur and oversized bytes are set to zero, so we can safely fetch 8 bytes"" ^objectMemory byteSwapped64IfBigEndian: (objectMemory fetchLong64: 0 ofObject: oop)] + ifFalse: ["((self sizeof: #'usqIntptr_t') = 8 - ifFalse: ["((self sizeof: #'unsigned long') = 8 and: [bs > 4]) ifTrue: [^objectMemory byteSwapped64IfBigEndian: (objectMemory fetchLong64: 0 ofObject: oop)] ifFalse: [^self cCoerceSimple: (objectMemory byteSwapped32IfBigEndian: (objectMemory fetchLong32: 0 ofObject: oop)) to: #'unsigned int']"]"! Item was changed: ----- Method: InterpreterPrimitives>>primitiveGetNextEvent (in category 'I/O primitives') ----- primitiveGetNextEvent "Primitive. Return the next input event from the VM event queue." | evtBuf arg value eventTypeIs | + <var: #evtBuf declareC:'sqIntptr_t evtBuf[8] = { 0, 0, 0, 0, 0, 0, 0, 0 }'> - <var: #evtBuf declareC:'long evtBuf[8] = { 0, 0, 0, 0, 0, 0, 0, 0 }'> self cCode: [] inSmalltalk: [evtBuf := objectMemory newInputEventAccessorOfSize: 8]. arg := self stackTop. ((objectMemory isArray: arg) and:[(objectMemory slotSizeOf: arg) = 8]) ifFalse: [^self primitiveFailFor: PrimErrBadArgument]. self ioGetNextEvent: (self cCoerce: evtBuf to: 'sqInputEvent*'). self successful ifFalse: [^nil]. "Event type" eventTypeIs := evtBuf at: 0. self storeInteger: 0 ofObject: arg withValue: (evtBuf at: 0). self successful ifFalse: [^nil]. eventTypeIs = 6 ifTrue: "Event is Complex, assume evtBuf is populated correctly and return" [1 to: 7 do: [:i | value := evtBuf at: i. self storePointer: i ofObject: arg withValue: value]] ifFalse: ["Event time stamp" self storeInteger: 1 ofObject: arg withValue: ((evtBuf at: 1) bitAnd: MillisecondClockMask). self successful ifFalse: [^nil]. "Event arguments" 2 to: 7 do:[:i| value := evtBuf at: i. (objectMemory isIntegerValue: value) ifTrue:[self storeInteger: i ofObject: arg withValue: value] ifFalse: [value := self positiveMachineIntegerFor: value. objectMemory storePointer: i ofObject: arg withValue: value]]]. self successful ifTrue: [self pop: 1]! Item was changed: ----- Method: InterpreterPrimitives>>signedMachineIntegerValueOf: (in category 'primitive support') ----- signedMachineIntegerValueOf: oop "Answer a signed value of an integer up to the size of a machine word. The object may be either a positive SmallInteger or a LargeInteger of size <= word size." + <returnTypeC: #'sqIntptr_t'> - <returnTypeC: #'long'> | negative ok bs value limit magnitude | + <var: #value type: #sqInt> + <var: #magnitude type: #'usqIntptr_t'> + <var: #limit type: #'usqIntptr_t'> - <var: #value type: #long> - <var: #magnitude type: #usqInt> - <var: #limit type: #usqInt> (objectMemory isIntegerObject: oop) ifTrue: [^objectMemory integerValueOf: oop]. (objectMemory isNonIntegerImmediate: oop) ifTrue: [^self primitiveFail]. ok := objectMemory isClassOfNonImm: oop equalTo: (objectMemory splObj: ClassLargePositiveInteger) compactClassIndex: ClassLargePositiveIntegerCompactIndex. ok ifTrue: [negative := false] ifFalse: [negative := true. ok := objectMemory isClassOfNonImm: oop equalTo: (objectMemory splObj: ClassLargeNegativeInteger) compactClassIndex: ClassLargeNegativeIntegerCompactIndex. ok ifFalse: [^self primitiveFail]]. bs := objectMemory numBytesOf: oop. + bs > (self sizeof: #'usqIntptr_t') ifTrue: - bs > (self sizeof: #'unsigned long') ifTrue: [^self primitiveFail]. "self cppIf: SPURVM ifTrue: [""Memory is 8 byte aligned in Spur and oversized bytes are set to zero, so we can safely fetch 8 bytes"" magnitude := objectMemory byteSwapped64IfBigEndian: (objectMemory fetchLong64: 0 ofObject: oop)] ifFalse: + ["((self sizeof: #'sqIntptr_t') = 8 - ["((self sizeof: #'unsigned long') = 8 and: [bs > 4]) ifTrue: [magnitude := objectMemory byteSwapped64IfBigEndian: (objectMemory fetchLong64: 0 ofObject: oop)] ifFalse: [magnitude := self cCoerceSimple: (objectMemory byteSwapped32IfBigEndian: (objectMemory fetchLong32: 0 ofObject: oop)) to: #'unsigned int']"]". + limit := 1 asUnsignedIntegerPtr << ((self sizeof: #'sqIntptr_t') * 8 - 1). - limit := 1 asUnsignedInteger << ((self sizeof: #usqInt) * 8 - 1). (negative ifTrue: [magnitude > limit] ifFalse: [magnitude >= limit]) ifTrue: [self primitiveFail. ^0]. negative ifTrue: [value := 0 - magnitude] ifFalse: [value := magnitude]. ^value! Item was changed: ----- Method: InterpreterProxy>>positiveMachineIntegerValueOf: (in category 'converting') ----- positiveMachineIntegerValueOf: oop + <returnTypeC: #'usqIntptr_t'> - <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>>signedMachineIntegerValueOf: (in category 'converting') ----- signedMachineIntegerValueOf: oop + <returnTypeC: #'sqIntptr_t'> - <returnTypeC: #'long'> oop isInteger ifFalse:[self error:'Not an integer object']. ^oop! Item was changed: ----- Method: InterpreterProxy>>stackPositiveMachineIntegerValue: (in category 'stack access') ----- stackPositiveMachineIntegerValue: offset + <returnTypeC: #'usqIntptr_t'> ^self positiveMachineIntegerValueOf: (self stackValue: offset)! Item was changed: ----- Method: InterpreterProxy>>stackSignedMachineIntegerValue: (in category 'stack access') ----- stackSignedMachineIntegerValue: offset + <returnTypeC: #'sqIntptr_t'> ^self signedMachineIntegerValueOf: (self stackValue: offset)! Item was changed: ----- Method: LargeIntegersPlugin>>digitSizeOfCSI: (in category 'util') ----- digitSizeOfCSI: csi "Answer the number of 32-bits fields of a C-SmallInteger. This value is the same as the largest legal subscript." ^(interpreterProxy maxSmallInteger <= 16r3FFFFFFF) ifTrue: [1] + ifFalse: [csi > 16rFFFFFFFF asIntegerPtr "conversion is not really needed here, but avoid generating a warning in 32bits, and harmless in 64bits" - ifFalse: [csi > 16rFFFFFFFF asLong "asLong is not really needed here, but avoid generating a warning in 32bits, and harmless in 64bits" ifTrue: [2] ifFalse: [csi < -16rFFFFFFFF ifTrue: [2] ifFalse: [1]]]! Item was changed: ----- Method: MacMenubarPlugin>>primitiveCreateStandardWindowMenu: (in category 'system primitives') ----- primitiveCreateStandardWindowMenu: inOptions <var: #menuHandle type: #MenuHandle> | menuHandle result | self primitive: 'primitiveCreateStandardWindowMenu' parameters: #(SmallInteger). self cppIf: #'TARGET_API_MAC_CARBON' ifTrue: [result := self cCode: 'CreateStandardWindowMenu(inOptions,&menuHandle);' inSmalltalk:[0]]. + ^interpreterProxy positiveMachineIntegerFor: (self cCoerce: menuHandle to: #'usqIntptr_t')! - ^interpreterProxy positiveMachineIntegerFor: (self cCoerce: menuHandle to: 'long')! Item was changed: ----- Method: MacMenubarPlugin>>primitiveGetIndMenuWithCommandID:commandID: (in category 'system primitives') ----- primitiveGetIndMenuWithCommandID: menuHandleOop commandID: aCommandID <var: #menuHandle type: #MenuHandle> <var: #commandID type: #MenuCommand> <var: #applicationMenu type: #MenuHandle> <var: #outIndex type: #MenuItemIndex> | menuHandle commandID applicationMenu outIndex | self primitive: 'primitiveGetIndMenuWithCommandID' parameters: #(Oop Oop). menuHandle := self cCoerce: (interpreterProxy positiveMachineIntegerValueOf: menuHandleOop) to: 'MenuHandle'. commandID := self cCoerce: (interpreterProxy positive32BitValueOf: aCommandID) to: 'MenuCommand'. (self ioCheckMenuHandle: menuHandle) ifFalse: [^interpreterProxy success: false]. self cppIf: #'TARGET_API_MAC_CARBON' ifTrue: [self cCode: 'GetIndMenuItemWithCommandID(menuHandle, kHICommandHide, 1, &applicationMenu, &outIndex);' inSmalltalk: [menuHandle]]. outIndex asSmallIntegerObj. "to avoid elimination of the variable..." + ^interpreterProxy positiveMachineIntegerFor: (self cCoerce: applicationMenu to: #'usqIntptr_t') - ^interpreterProxy positiveMachineIntegerFor: (self cCoerce: applicationMenu to: 'long') ! Item was changed: ----- Method: MacMenubarPlugin>>primitiveGetMenuBar (in category 'system primitives') ----- primitiveGetMenuBar <var: #menuHandle type: #Handle> | menuHandle | self primitive: 'primitiveGetMenuBar' parameters: #(). menuHandle := self cCode: 'GetMenuBar()' inSmalltalk:[0]. + ^interpreterProxy positiveMachineIntegerFor: (self cCoerce: menuHandle to: #'usqIntptr_t')! - ^interpreterProxy positiveMachineIntegerFor: (self cCoerce: menuHandle to: 'long')! Item was changed: ----- Method: MacMenubarPlugin>>primitiveGetMenuHandle: (in category 'system primitives') ----- primitiveGetMenuHandle: menuID <var: #menuHandle type: #MenuHandle> <var: #menuID type: #MenuID> | menuHandle | self primitive: 'primitiveGetMenuHandle' parameters: #(SmallInteger). menuHandle := self cCode: 'GetMenuHandle(menuID)' inSmalltalk:[0]. + ^interpreterProxy positiveMachineIntegerFor: (self cCoerce: menuHandle to: #'usqIntptr_t')! - ^interpreterProxy positiveMachineIntegerFor: (self cCoerce: menuHandle to: 'long')! Item was changed: ----- Method: MacMenubarPlugin>>primitiveNewMenu:menuTitle: (in category 'system primitives') ----- primitiveNewMenu: menuID menuTitle: menuTitle <var: #menuHandle type: #MenuHandle> <var: #constStr255 type: #ConstStr255Param> <var: #menuID type: #MenuID> | menuHandle constStr255 | self primitive: 'primitiveNewMenu' parameters: #(SmallInteger ByteArray). constStr255 := self cCoerce: menuTitle to: #ConstStr255Param. menuHandle := self cCode: 'NewMenu(menuID,constStr255)' inSmalltalk:[0]. + ^interpreterProxy positiveMachineIntegerFor: (self cCoerce: menuHandle to: #'usqIntptr_t')! - ^interpreterProxy positiveMachineIntegerFor: (self cCoerce: menuHandle to: 'long')! Item was changed: ----- Method: QuicktimePlugin>>primitiveSetGWorldPtrOntoExistingSurface:gWorld:width:height:rowBytes:depth:movie: (in category 'system primitives') ----- primitiveSetGWorldPtrOntoExistingSurface: surfaceID gWorld: bitMapPtr width: width height: height rowBytes: rowBytes depth: depth movie: moviePtr | buffer movie | <var: #buffer type: #'char *'> + <var: #movie type: #'sqIntptr_t'> - <var: #movie type: #'long'> self primitive: 'primitiveSetGWorldPtrOntoExistingSurface' parameters:#(SmallInteger Oop SmallInteger SmallInteger SmallInteger SmallInteger Oop). buffer := self cCoerce: (interpreterProxy positiveMachineIntegerValueOf: bitMapPtr) to: 'char *'. + movie := self cCoerce: (interpreterProxy positiveMachineIntegerValueOf: moviePtr) to: #'sqIntptr_t'. - movie := self cCoerce: (interpreterProxy positiveMachineIntegerValueOf: moviePtr) to: 'long'. self stQuicktimeSetToExistingSurface: surfaceID gworld: buffer width: width height: height rowBytes: rowBytes depth: depth movie: movie. ! Item was changed: ----- Method: QuicktimePlugin>>primitiveSetGWorldPtrOntoSurface:width:height:rowBytes:depth:movie: (in category 'system primitives') ----- primitiveSetGWorldPtrOntoSurface: bitMapPtr width: width height: height rowBytes: rowBytes depth: depth movie: moviePtr | buffer movie results | <var: #buffer type: #'char *'> + <var: #movie type: #'sqIntptr_t'> - <var: #movie type: #'long'> self primitive: 'primitiveSetGWorldPtrOntoSurface' parameters:#(Oop SmallInteger SmallInteger SmallInteger SmallInteger Oop). buffer := self cCoerce: (interpreterProxy positiveMachineIntegerValueOf: bitMapPtr) to: 'char *'. + movie := self cCoerce: (interpreterProxy positiveMachineIntegerValueOf: moviePtr) to: #'sqIntptr_t'. - movie := self cCoerce: (interpreterProxy positiveMachineIntegerValueOf: moviePtr) to: 'long'. results := self stQuicktimeSetSurface: buffer width: width height: height rowBytes: rowBytes depth: depth movie: movie. ^results asOop: SmallInteger ! Item was changed: ----- Method: SimpleStackBasedCogit>>compileInterpreterPrimitive: (in category 'primitive generators') ----- compileInterpreterPrimitive: primitiveRoutine "Compile a call to an interpreter primitive. Call the C routine with the usual stack-switching dance, test the primFailCode and then either return on success or continue to the method body." <var: #primitiveRoutine declareC: 'void (*primitiveRoutine)(void)'> | flags jmp jmpSamplePrim continuePostSamplePrim jmpSampleNonPrim continuePostSampleNonPrim | <var: #jmp type: #'AbstractInstruction *'> <var: #jmpSamplePrim type: #'AbstractInstruction *'> <var: #jmpSampleNonPrim type: #'AbstractInstruction *'> <var: #continuePostSamplePrim type: #'AbstractInstruction *'> <var: #continuePostSampleNonPrim type: #'AbstractInstruction *'> "Save processor fp, sp and return pc in the interpreter's frame stack and instruction pointers" self genExternalizePointersForPrimitiveCall. "Switch to the C stack." self genLoadCStackPointersForPrimCall. flags := coInterpreter primitivePropertyFlags: primitiveIndex. (flags anyMask: PrimCallDoNotJIT) ifTrue: [^ShouldNotJIT]. (flags anyMask: PrimCallCollectsProfileSamples) ifTrue: ["Test nextProfileTick for being non-zero and call checkProfileTick if so" objectMemory wordSize = 4 ifTrue: [self MoveAw: coInterpreter nextProfileTickAddress R: TempReg. self MoveAw: coInterpreter nextProfileTickAddress + objectMemory wordSize R: ClassReg. self OrR: TempReg R: ClassReg] ifFalse: [self MoveAw: coInterpreter nextProfileTickAddress R: TempReg. self CmpCq: 0 R: TempReg]. "If set, jump to record sample call." jmpSampleNonPrim := self JumpNonZero: 0. continuePostSampleNonPrim := self Label]. "Old full prim trace is in VMMaker-eem.550 and prior" self recordPrimTrace ifTrue: [self genFastPrimTraceUsing: ClassReg and: SendNumArgsReg]. "Clear the primFailCode and set argumentCount" self MoveCq: 0 R: TempReg. self MoveR: TempReg Aw: coInterpreter primFailCodeAddress. methodOrBlockNumArgs ~= 0 ifTrue: [self MoveCq: methodOrBlockNumArgs R: TempReg]. self MoveR: TempReg Aw: coInterpreter argumentCountAddress. "If required, set primitiveFunctionPointer and newMethod" (flags anyMask: PrimCallNeedsPrimitiveFunction) ifTrue: [self MoveCw: primitiveRoutine asInteger R: TempReg. primSetFunctionLabel := self MoveR: TempReg Aw: coInterpreter primitiveFunctionPointerAddress]. (flags anyMask: PrimCallNeedsNewMethod+PrimCallMayCallBack) ifTrue: ["The ceActivateFailingPrimitiveMethod: machinery can't handle framelessness." (flags anyMask: PrimCallMayCallBack) ifTrue: [needsFrame := true]. methodLabel addDependent: (self annotateAbsolutePCRef: (self MoveCw: methodLabel asInteger R: ClassReg)). self MoveMw: (self offset: CogMethod of: #methodObject) r: ClassReg R: TempReg. self MoveR: TempReg Aw: coInterpreter newMethodAddress]. "Invoke the primitive" self PrefetchAw: coInterpreter primFailCodeAddress. (flags anyMask: PrimCallMayCallBack) ifTrue: "Sideways call the C primitive routine so that we return through cePrimReturnEnterCogCode." ["On Spur ceActivateFailingPrimitiveMethod: would like to retry if forwarders are found. So insist on PrimCallNeedsPrimitiveFunction being set too." self assert: (flags anyMask: PrimCallNeedsPrimitiveFunction). backEnd genSubstituteReturnAddress: ((flags anyMask: PrimCallCollectsProfileSamples) ifTrue: [cePrimReturnEnterCogCodeProfiling] ifFalse: [cePrimReturnEnterCogCode]). primInvokeInstruction := self JumpFullRT: primitiveRoutine asInteger. jmp := jmpSamplePrim := continuePostSamplePrim := nil] ifFalse: ["Call the C primitive routine." primInvokeInstruction := self CallFullRT: primitiveRoutine asInteger. (flags anyMask: PrimCallCollectsProfileSamples) ifTrue: [self assert: (flags anyMask: PrimCallNeedsNewMethod). "Test nextProfileTick for being non-zero and call checkProfileTick if so" objectMemory wordSize = 4 ifTrue: [self MoveAw: coInterpreter nextProfileTickAddress R: TempReg. self MoveAw: coInterpreter nextProfileTickAddress + objectMemory wordSize R: ClassReg. self OrR: TempReg R: ClassReg] ifFalse: [self MoveAw: coInterpreter nextProfileTickAddress R: TempReg. self CmpCq: 0 R: TempReg]. "If set, jump to record sample call." jmpSamplePrim := self JumpNonZero: 0. continuePostSamplePrim := self Label]. objectRepresentation maybeCompileRetryOnPrimitiveFail: primitiveIndex. self maybeCompileAllocFillerCheck. "Switch back to the Smalltalk stack. Stack better be in either of these two states: success: stackPointer -> result (was receiver) arg1 ... argN return pc failure: receiver arg1 ... stackPointer -> argN return pc In either case we can push the instructionPointer or load it into the LinkRegister to reestablish the return pc" self MoveAw: coInterpreter instructionPointerAddress R: (backEnd hasLinkRegister ifTrue: [LinkReg] ifFalse: [ClassReg]). backEnd genLoadStackPointers. "Test primitive failure" self MoveAw: coInterpreter primFailCodeAddress R: TempReg. backEnd hasLinkRegister ifFalse: [self PushR: ClassReg]. "Restore return pc on CISCs" self flag: 'ask concrete code gen if move sets condition codes?'. self CmpCq: 0 R: TempReg. jmp := self JumpNonZero: 0. "Fetch result from stack" self MoveMw: (backEnd hasLinkRegister ifTrue: [0] ifFalse: [objectMemory wordSize]) r: SPReg R: ReceiverResultReg. self RetN: objectMemory wordSize]. "return to caller, popping receiver" (flags anyMask: PrimCallCollectsProfileSamples) ifTrue: ["The sample is collected by cePrimReturnEnterCogCode for external calls" jmpSamplePrim ifNotNil: ["Call ceCheckProfileTick: to record sample and then continue." jmpSamplePrim jmpTarget: self Label. self assert: (flags anyMask: PrimCallNeedsNewMethod). + self CallFullRT: (self cCode: [#ceCheckProfileTick asUnsignedIntegerPtr] - self CallFullRT: (self cCode: [#ceCheckProfileTick asUnsignedLong] inSmalltalk: [self simulatedTrampolineFor: #ceCheckProfileTick]). "reenter the post-primitive call flow" self Jump: continuePostSamplePrim]. "Null newMethod and call ceCheckProfileTick: to record sample and then continue. ceCheckProfileTick will map null/0 to coInterpreter nilObject" jmpSampleNonPrim jmpTarget: self Label. self MoveCq: 0 R: TempReg. self MoveR: TempReg Aw: coInterpreter newMethodAddress. + self CallFullRT: (self cCode: [#ceCheckProfileTick asUnsignedIntegerPtr] - self CallFullRT: (self cCode: [#ceCheckProfileTick asUnsignedLong] inSmalltalk: [self simulatedTrampolineFor: #ceCheckProfileTick]). "reenter the post-primitive call flow" self Jump: continuePostSampleNonPrim]. jmp ifNotNil: ["Jump to restore of receiver reg and proceed to frame build for failure." jmp jmpTarget: self Label. "Restore receiver reg from stack. If on RISCs ret pc is in LinkReg, if on CISCs ret pc is on stack." self MoveMw: objectMemory wordSize * (methodOrBlockNumArgs + (backEnd hasLinkRegister ifTrue: [0] ifFalse: [1])) r: SPReg R: ReceiverResultReg]. ^0! Item was changed: ----- Method: SimpleStackBasedCogit>>genPrimReturnEnterCogCodeEnilopmart: (in category 'initialization') ----- genPrimReturnEnterCogCodeEnilopmart: profiling "Generate the substitute return code for an external or FFI primitive call. On success simply return, extracting numArgs from newMethod. On primitive failure call ceActivateFailingPrimitiveMethod: newMethod." | jmpSample continuePostSample jmpFail | <var: #jmpSample type: #'AbstractInstruction *'> <var: #continuePostSample type: #'AbstractInstruction *'> <var: #jmpFail type: #'AbstractInstruction *'> self zeroOpcodeIndex. backEnd hasVarBaseRegister ifTrue: [self MoveCq: self varBaseAddress R: VarBaseReg]. "Must happen sometime" profiling ifTrue: ["Test nextProfileTick for being non-zero and call checkProfileTick: if so. N.B. nextProfileTick is 64-bits so 32-bit systems need to test both halves." objectMemory wordSize = 4 ifTrue: [self MoveAw: coInterpreter nextProfileTickAddress R: TempReg. self MoveAw: coInterpreter nextProfileTickAddress + objectMemory wordSize R: ClassReg. self OrR: TempReg R: ClassReg] ifFalse: [self MoveAw: coInterpreter nextProfileTickAddress R: TempReg. self CmpCq: 0 R: TempReg]. "If set, jump to record sample call." jmpSample := self JumpNonZero: 0. continuePostSample := self Label]. self maybeCompileAllocFillerCheck. "Test primitive failure" self MoveAw: coInterpreter primFailCodeAddress R: TempReg. self flag: 'ask concrete code gen if move sets condition codes?'. self CmpCq: 0 R: TempReg. jmpFail := self JumpNonZero: 0. "Switch back to the Smalltalk stack. Stack better be in either of these two states: success: stackPointer -> result (was receiver) arg1 ... argN return pc failure: receiver arg1 ... stackPointer -> argN return pc We push the instructionPointer to reestablish the return pc in the success case, but leave it to ceActivateFailingPrimitiveMethod: to do so in the failure case." backEnd hasLinkRegister ifTrue: [backEnd genLoadStackPointers. "Switch back to Smalltalk stack." backEnd hasPCRegister ifTrue: [self PopR: ReceiverResultReg. "Pop result from stack" self MoveAw: coInterpreter instructionPointerAddress R: PCReg] "Return" ifFalse: [self MoveMw: 0 r: SPReg R: ReceiverResultReg. "Fetch result from stack" self MoveAw: coInterpreter instructionPointerAddress R: LinkReg. "Get ret pc" self RetN: objectMemory wordSize]] "Return, popping result from stack" ifFalse: [self MoveAw: coInterpreter instructionPointerAddress R: ClassReg. "Get return pc" backEnd genLoadStackPointers. "Switch back to Smalltalk stack." self MoveMw: 0 r: SPReg R: ReceiverResultReg. "Fetch result from stack" self MoveR: ClassReg Mw: 0 r: SPReg. "Restore return pc" self RetN: 0]. "Return, popping result from stack" "Primitive failed. Invoke C code to build the frame and continue." jmpFail jmpTarget: (self MoveAw: coInterpreter newMethodAddress R: SendNumArgsReg). "Reload sp with CStackPointer; easier than popping args of checkProfileTick." self MoveAw: self cStackPointerAddress R: SPReg. self compileCallFor: #ceActivateFailingPrimitiveMethod: numArgs: 1 arg: SendNumArgsReg arg: nil arg: nil arg: nil resultReg: NoReg regsToSave: self emptyRegisterMask. "On Spur ceActivateFailingPrimitiveMethod: may retry the primitive and return if successful. So continue by returning to the caller. Switch back to the Smalltalk stack. Stack should be in this state: success: stackPointer -> result (was receiver) arg1 ... argN return pc We can push the instructionPointer or load it into the LinkRegister to reestablish the return pc" self MoveAw: coInterpreter instructionPointerAddress R: (backEnd hasLinkRegister ifTrue: [LinkReg] ifFalse: [ClassReg]). backEnd genLoadStackPointers. backEnd hasLinkRegister ifTrue: [self MoveMw: 0 r: SPReg R: ReceiverResultReg] "Fetch result from stack" ifFalse: [self MoveMw: objectMemory wordSize r: SPReg R: ReceiverResultReg. "Fetch result from stack" self PushR: ClassReg]. "Restore return pc on CISCs" self RetN: objectMemory wordSize. "return to caller, popping receiver" profiling ifTrue: ["Call ceCheckProfileTick: to record sample and then continue. newMethod should be up-to-date. Need to save and restore the link reg around this call." jmpSample jmpTarget: self Label. backEnd saveAndRestoreLinkRegAround: + [self CallFullRT: (self cCode: '(usqIntptr_t)ceCheckProfileTick' - [self CallFullRT: (self cCode: '(unsigned long)ceCheckProfileTick' inSmalltalk: [self simulatedTrampolineFor: #ceCheckProfileTick])]. self Jump: continuePostSample]! Item was changed: ----- Method: SmartSyntaxPluginCodeGenerator>>generateCPtrAsOop:on:indent: (in category 'translating builtins') ----- generateCPtrAsOop: aNode on: aStream indent: anInteger + aStream nextPutAll: '((sqInt)(sqIntptr_t)('. - aStream nextPutAll: '((sqInt)(long)('. self emitCExpression: aNode receiver on: aStream. aStream nextPutAll: ') - BaseHeaderSize)'! Item was changed: ----- Method: SpurMemoryManager>>printOopsFrom:to: (in category 'debug printing') ----- printOopsFrom: startAddress to: endAddress <api> | oop limit | oop := self objectBefore: startAddress. + limit := endAddress asUnsignedIntegerPtr min: endOfMemory. - limit := endAddress asUnsignedLong min: endOfMemory. oop := oop ifNil: [startAddress] ifNotNil: [(self objectAfter: oop) = startAddress ifTrue: [startAddress] ifFalse: [oop]]. [self oop: oop isLessThan: limit] whileTrue: [coInterpreter printHex: oop; print: '/'; printNum: oop; space; print: ((self isFreeObject: oop) ifTrue: ['free'] ifFalse: [(self isSegmentBridge: oop) ifTrue: ['bridge'] ifFalse: [(self isForwarded: oop) ifTrue: ['forwarder'] ifFalse: ['object']]]); cr. oop := self objectAfter: oop]! Item was changed: ----- Method: SpurSegmentManager>>addSegmentOfSize: (in category 'growing/shrinking memory') ----- addSegmentOfSize: ammount <returnTypeC: #'SpurSegmentInfo *'> <inline: false> | allocatedSize | <var: #newSeg type: #'SpurSegmentInfo *'> <var: #segAddress type: #'void *'> <var: #allocatedSize type: #'usqInt'> self cCode: [] inSmalltalk: [segments ifNil: [^nil]]. "bootstrap" (manager "sent to the manager so that the simulator can increase memory to simulate a new segment" sqAllocateMemorySegmentOfSize: ammount Above: (self firstGapOfSizeAtLeast: ammount) AllocatedSizeInto: (self cCode: [self addressOf: allocatedSize] inSmalltalk: [[:sz| allocatedSize := sz]])) ifNotNil: [:segAddress| | newSegIndex newSeg | + newSegIndex := self insertSegmentFor: segAddress asUnsignedIntegerPtr. - newSegIndex := self insertSegmentFor: segAddress asUnsignedLong. newSeg := self addressOf: (segments at: newSegIndex). newSeg + segStart: segAddress asUnsignedIntegerPtr; - segStart: segAddress asUnsignedLong; segSize: allocatedSize. self bridgeFrom: (self addressOf: (segments at: newSegIndex - 1)) to: newSeg. self bridgeFrom: newSeg to: (newSegIndex = (numSegments - 1) ifFalse: [self addressOf: (segments at: newSegIndex + 1)]). "test isInMemory:" 0 to: numSegments - 1 do: [:i| self assert: (self isInSegments: (segments at: i) segStart). self assert: (self isInSegments: (segments at: i) segLimit - manager wordSize). self assert: ((self isInSegments: (segments at: i) segLimit) not or: [i < (numSegments - 1) and: [(segments at: i) segLimit = (segments at: i + 1) segStart]]). self assert: ((self isInSegments: (segments at: i) segStart - manager wordSize) not or: [i > 0 and: [(segments at: i - 1) segLimit = (segments at: i) segStart]])]. ^newSeg]. ^nil! Item was changed: ----- Method: StackInterpreter class>>declareCVarsIn: (in category 'translation') ----- declareCVarsIn: aCCodeGenerator | vmClass | self class == thisContext methodClass ifFalse: [^self]. "Don't duplicate decls in subclasses" vmClass := aCCodeGenerator vmClass. "Generate primitiveTable etc based on vmClass, not just StackInterpreter" aCCodeGenerator addHeaderFile:'<stddef.h> /* for e.g. alloca */'; addHeaderFile:'<setjmp.h>'; addHeaderFile:'<wchar.h> /* for wint_t */'; addHeaderFile:'"vmCallback.h"'; addHeaderFile:'"sqMemoryFence.h"'; addHeaderFile:'"dispdbg.h"'. LowcodeVM ifTrue: [ aCCodeGenerator addHeaderFile:'"sqLowcodeFFI.h"']. vmClass declareInterpreterVersionIn: aCCodeGenerator defaultName: 'Stack'. aCCodeGenerator var: #interpreterProxy type: #'struct VirtualMachine*'. aCCodeGenerator declareVar: #sendTrace type: 'volatile int'; + declareVar: #byteCount type: #usqInt. - declareVar: #byteCount type: 'unsigned long'. "These need to be pointers or unsigned." self declareC: #(instructionPointer method newMethod) as: #usqInt in: aCCodeGenerator. "These are all pointers; char * because Slang has no support for C pointer arithmetic." self declareC: #(localIP localSP localFP nativeSP stackPointer framePointer stackLimit breakSelector nativeStackPointer nativeFramePointer shadowCallStack) as: #'char *' in: aCCodeGenerator. aCCodeGenerator var: #breakSelectorLength declareC: 'sqInt breakSelectorLength = MinSmallInteger'. self declareC: #(stackPage overflowedPage) as: #'StackPage *' in: aCCodeGenerator. aCCodeGenerator removeVariable: 'stackPages'. "this is an implicit receiver in the translated code." NewspeakVM ifFalse: [aCCodeGenerator removeVariable: 'localAbsentReceiver'; removeVariable: 'localAbsentReceiverOrZero'; removeVariable: 'nsMethodCache']. "This defines bytecodeSetSelector as 0 if MULTIPLEBYTECODESETS is not defined, for the benefit of the interpreter on slow machines." aCCodeGenerator addConstantForBinding: (self bindingOf: #MULTIPLEBYTECODESETS). MULTIPLEBYTECODESETS == false ifTrue: [aCCodeGenerator removeVariable: 'bytecodeSetSelector']. BytecodeSetHasExtensions == false ifTrue: [aCCodeGenerator removeVariable: 'extA'; removeVariable: 'extB']. aCCodeGenerator var: #methodCache + declareC: 'sqIntptr_t methodCache[MethodCacheSize + 1 /* ', (MethodCacheSize + 1) printString, ' */]'. - declareC: 'long methodCache[MethodCacheSize + 1 /* ', (MethodCacheSize + 1) printString, ' */]'. aCCodeGenerator var: #nsMethodCache + declareC: 'sqIntptr_t nsMethodCache[NSMethodCacheSize + 1 /* ', (NSMethodCacheSize + 1) printString, ' */]'. - declareC: 'long nsMethodCache[NSMethodCacheSize + 1 /* ', (NSMethodCacheSize + 1) printString, ' */]'. AtCacheTotalSize isInteger ifTrue: [aCCodeGenerator var: #atCache declareC: 'sqInt atCache[AtCacheTotalSize + 1 /* ', (AtCacheTotalSize + 1) printString, ' */]']. aCCodeGenerator var: #primitiveTable declareC: 'void (*primitiveTable[MaxPrimitiveIndex + 2 /* ', (MaxPrimitiveIndex + 2) printString, ' */])(void) = ', vmClass primitiveTableString. vmClass primitiveTable do: [:symbolOrNot| (symbolOrNot isSymbol and: [symbolOrNot ~~ #primitiveFail]) ifTrue: [(aCCodeGenerator methodNamed: symbolOrNot) ifNotNil: [:tMethod| tMethod returnType: #void]]]. vmClass objectMemoryClass hasSpurMemoryManagerAPI ifTrue: [aCCodeGenerator var: #primitiveAccessorDepthTable type: 'signed char' sizeString: 'MaxPrimitiveIndex + 2 /* ', (MaxPrimitiveIndex + 2) printString, ' */' array: vmClass primitiveAccessorDepthTable] ifFalse: [aCCodeGenerator removeVariable: #primitiveAccessorDepthTable]. aCCodeGenerator var: #primitiveFunctionPointer declareC: 'void (*primitiveFunctionPointer)()'. aCCodeGenerator var: #externalPrimitiveTable declareC: 'void (*externalPrimitiveTable[MaxExternalPrimitiveTableSize + 1 /* ', (MaxExternalPrimitiveTableSize + 1) printString, ' */])(void)'. aCCodeGenerator var: #showSurfaceFn type: #'void *'. aCCodeGenerator var: #jmpBuf declareC: 'jmp_buf jmpBuf[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'. aCCodeGenerator var: #suspendedCallbacks declareC: 'usqInt suspendedCallbacks[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'. aCCodeGenerator var: #suspendedMethods declareC: 'usqInt suspendedMethods[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'. aCCodeGenerator var: #interruptCheckChain declareC: 'void (*interruptCheckChain)(void) = 0'. self declareCAsUSqLong: #(nextPollUsecs nextWakeupUsecs longRunningPrimitiveGCUsecs longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs "these are high-frequency enough that they're overflowing quite quickly on modern hardware" statProcessSwitch statIOProcessEvents statForceInterruptCheck statCheckForEvents statStackOverflow statStackPageDivorce) in: aCCodeGenerator. aCCodeGenerator var: #nextProfileTick type: #sqLong. LowcodeVM ifTrue: [ aCCodeGenerator var: #shadowCallStackPointer type: #'char*'. aCCodeGenerator var: #lowcodeCalloutState type: #'sqLowcodeCalloutState*' ].! Item was changed: ----- Method: StackInterpreter>>addNewMethodToCache: (in category 'method lookup cache') ----- addNewMethodToCache: classObj "Add the given entry to the method cache. The policy is as follows: Look for an empty entry anywhere in the reprobe chain. If found, install the new entry there. If not found, then install the new entry at the first probe position and delete the entries in the rest of the reprobe chain. This has two useful purposes: If there is active contention over the first slot, the second or third will likely be free for reentry after ejection. Also, flushing is good when reprobe chains are getting full." | probe hash primitiveIndex | <inline: false> hash := objectMemory methodCacheHashOf: messageSelector with: (objectMemory classTagForClass: classObj). "shift drops low-order zeros from addresses" (objectMemory isOopCompiledMethod: newMethod) ifTrue: [primitiveIndex := self primitiveIndexOf: newMethod. primitiveFunctionPointer := self functionPointerFor: primitiveIndex inClass: classObj] ifFalse: [self assert: ((objectMemory isNonImmediate: newMethod) and: [objectMemory isForwarded: newMethod]) not. primitiveFunctionPointer := #primitiveInvokeObjectAsMethod]. 0 to: CacheProbeMax-1 do: [:p | probe := (hash >> p) bitAnd: MethodCacheMask. (methodCache at: probe + MethodCacheSelector) = 0 ifTrue: ["Found an empty entry -- use it" methodCache at: probe + MethodCacheSelector put: messageSelector. methodCache at: probe + MethodCacheClass put: (objectMemory classTagForClass: classObj). methodCache at: probe + MethodCacheMethod put: newMethod. + methodCache at: probe + MethodCachePrimFunction put: (self cCoerce: primitiveFunctionPointer to: #'sqIntptr_t'). - methodCache at: probe + MethodCachePrimFunction put: (self cCoerce: primitiveFunctionPointer to: #long). lastMethodCacheProbeWrite := probe. "this for primitiveExternalMethod" ^self]]. "OK, we failed to find an entry -- install at the first slot..." probe := hash bitAnd: MethodCacheMask. "first probe" methodCache at: probe + MethodCacheSelector put: messageSelector. methodCache at: probe + MethodCacheClass put: (objectMemory classTagForClass: classObj). methodCache at: probe + MethodCacheMethod put: newMethod. + methodCache at: probe + MethodCachePrimFunction put: (self cCoerce: primitiveFunctionPointer to: #'sqIntptr_t'). - methodCache at: probe + MethodCachePrimFunction put: (self cCoerce: primitiveFunctionPointer to: #long). lastMethodCacheProbeWrite := probe. "this for primitiveExternalMethod" "...and zap the following entries" 1 to: CacheProbeMax-1 do: [:p | probe := (hash >> p) bitAnd: MethodCacheMask. methodCache at: probe + MethodCacheSelector put: 0]! Item was changed: ----- Method: StackInterpreter>>addNewMethodToNSCache: (in category 'method lookup cache') ----- addNewMethodToNSCache: rule <option: #NewspeakVM> <inline: false> | classObj probe hash primitiveIndex | classObj := lkupClass. hash := (objectMemory methodCacheHashOf: messageSelector with: lkupClassTag) bitXor: (method bitXor: rule). self deny: rule = LookupRuleOrdinary. (objectMemory isOopCompiledMethod: newMethod) ifTrue: [primitiveIndex := self primitiveIndexOf: newMethod. primitiveFunctionPointer := self functionPointerFor: primitiveIndex inClass: classObj] ifFalse: [self assert: ((objectMemory isNonImmediate: newMethod) and: [objectMemory isForwarded: newMethod]) not. primitiveFunctionPointer := #primitiveInvokeObjectAsMethod]. 0 to: CacheProbeMax-1 do: [:p | probe := (hash >> p) bitAnd: NSMethodCacheMask. (nsMethodCache at: probe + NSMethodCacheSelector) = 0 ifTrue: ["Found an empty entry -- use it" nsMethodCache at: probe + NSMethodCacheSelector put: messageSelector. nsMethodCache at: probe + NSMethodCacheClassTag put: lkupClassTag. "(objectMemory classTagForClass: classObj)." nsMethodCache at: probe + NSMethodCacheCallingMethod put: method. nsMethodCache at: probe + NSMethodCacheDepthOrLookupRule put: rule. nsMethodCache at: probe + NSMethodCacheTargetMethod put: newMethod. + nsMethodCache at: probe + NSMethodCachePrimFunction put: (self cCoerce: primitiveFunctionPointer to: #'sqIntptr_t'). - nsMethodCache at: probe + NSMethodCachePrimFunction put: (self cCoerce: primitiveFunctionPointer to: #long). nsMethodCache at: probe + NSMethodCacheActualReceiver put: localAbsentReceiverOrZero. "lastMethodCacheProbeWrite := probe." "this for primitiveExternalMethod" ^self]]. "OK, we failed to find an entry -- install at the first slot..." probe := hash bitAnd: NSMethodCacheMask. "first probe" nsMethodCache at: probe + NSMethodCacheSelector put: messageSelector. nsMethodCache at: probe + NSMethodCacheClassTag put: lkupClassTag. "(objectMemory classTagForClass: classObj)." nsMethodCache at: probe + NSMethodCacheCallingMethod put: method. nsMethodCache at: probe + NSMethodCacheDepthOrLookupRule put: rule. nsMethodCache at: probe + NSMethodCacheTargetMethod put: newMethod. + nsMethodCache at: probe + NSMethodCachePrimFunction put: (self cCoerce: primitiveFunctionPointer to: #'sqIntptr_t'). - nsMethodCache at: probe + NSMethodCachePrimFunction put: (self cCoerce: primitiveFunctionPointer to: #long). nsMethodCache at: probe + NSMethodCacheActualReceiver put: localAbsentReceiverOrZero. "lastMethodCacheProbeWrite := probe. ""this for primitiveExternalMethod" "...and zap the following entries" 1 to: CacheProbeMax-1 do: [:p | probe := (hash >> p) bitAnd: NSMethodCacheMask. nsMethodCache at: probe + NSMethodCacheSelector put: 0]! Item was changed: ----- Method: StackInterpreter>>isPrimitiveFunctionPointerAnIndex (in category 'primitive support') ----- isPrimitiveFunctionPointerAnIndex "We save slots in the method cache by using the primitiveFunctionPointer to hold either a function pointer or the index of a quick primitive. Since quick primitive indices are small they can't be confused with function addresses. " + ^(self cCoerce: primitiveFunctionPointer to: #'usqIntptr_t') <= MaxQuickPrimitiveIndex! - ^(self cCoerce: primitiveFunctionPointer to: 'unsigned long') <= MaxQuickPrimitiveIndex! Item was changed: ----- Method: StackInterpreter>>longPrintOop: (in category 'debug printing') ----- longPrintOop: oop <api> | fmt lastIndex startIP bytecodesPerLine column | ((objectMemory isImmediate: oop) or: [(objectMemory addressCouldBeObj: oop) not or: [(oop bitAnd: objectMemory allocationUnit - 1) ~= 0 or: [(objectMemory isFreeObject: oop) or: [objectMemory isForwarded: oop]]]]) ifTrue: [self printOop: oop. ^self]. self printHex: oop. (objectMemory fetchClassOfNonImm: oop) ifNil: [self print: ' has a nil class!!!!'] ifNotNil: [:class| self print: ': a(n) '; printNameOfClass: class count: 5; print: ' ('. objectMemory hasSpurMemoryManagerAPI ifTrue: [self printHexnp: (objectMemory compactClassIndexOf: oop); print: '=>']. self printHexnp: class; print: ')']. fmt := objectMemory formatOf: oop. self print: ' format '; printHexnp: fmt. fmt > objectMemory lastPointerFormat ifTrue: [self print: ' nbytes '; printNum: (objectMemory numBytesOf: oop)] ifFalse: [(objectMemory isIndexableFormat: fmt) ifTrue: [| len | len := objectMemory lengthOf: oop. self print: ' size '; printNum: len - (objectMemory fixedFieldsOf: oop format: fmt length: len)]]. objectMemory printHeaderTypeOf: oop. self print: ' hash '; printHexnp: (objectMemory rawHashBitsOf: oop). self cr. (fmt between: objectMemory firstByteFormat and: objectMemory firstCompiledMethodFormat - 1) ifTrue: [^self printStringOf: oop; cr]. (fmt between: objectMemory firstLongFormat and: objectMemory firstByteFormat - 1) ifTrue: [0 to: ((objectMemory num32BitUnitsOf: oop) min: 256) - 1 do: [:i| | fieldOop | fieldOop := objectMemory fetchLong32: i ofObject: oop. self space; printNum: i; space; printHex: fieldOop; space; cr]. ^self]. "this is nonsense. apologies." startIP := (objectMemory lastPointerOf: oop) + objectMemory bytesPerOop - objectMemory baseHeaderSize / objectMemory bytesPerOop. lastIndex := 256 min: startIP. lastIndex > 0 ifTrue: [1 to: lastIndex do: [:i| | fieldOop | fieldOop := objectMemory fetchPointer: i - 1 ofObject: oop. self space; printNum: i - 1; space; printHex: fieldOop; space. (i = 1 and: [objectMemory isCompiledMethod: oop]) ifTrue: [self printMethodHeaderOop: fieldOop] ifFalse: [self cCode: [self printOopShort: fieldOop] inSmalltalk: [self print: (self shortPrint: fieldOop)]]. self cr]]. (objectMemory isCompiledMethod: oop) ifFalse: [startIP > lastIndex ifTrue: [self print: '...'; cr]] ifTrue: [startIP := startIP * objectMemory wordSize + 1. lastIndex := objectMemory lengthOf: oop. lastIndex - startIP > 100 ifTrue: [lastIndex := startIP + 100]. bytecodesPerLine := 8. column := 1. startIP to: lastIndex do: [:index| | byte | column = 1 ifTrue: + [self cCode: 'printf("0x%08" PRIxSQPTR ": ", (usqIntptr_t)(oop+BaseHeaderSize+index-1))' - [self cCode: 'printf("0x%08lx: ", (unsigned long)(oop+BaseHeaderSize+index-1))' inSmalltalk: [self print: (oop+objectMemory baseHeaderSize+index-1) hex; print: ': ']]. byte := objectMemory fetchByte: index - 1 ofObject: oop. self cCode: 'printf(" %02x/%-3d", (int)byte,(int)byte)' inSmalltalk: [self space; print: (byte radix: 16); printChar: $/; printNum: byte]. column := column + 1. column > bytecodesPerLine ifTrue: [column := 1. self cr]]. column = 1 ifFalse: [self cr]]! Item was changed: ----- Method: StackInterpreter>>positiveMachineIntegerFor: (in category 'callback support') ----- positiveMachineIntegerFor: value + <var: #value type: #'usqIntptr_t'> - <var: #value type: #'unsigned long'> <inline: false> | resultObj | objectMemory wordSize = 8 ifTrue: [resultObj := self positive64BitIntegerFor: value] ifFalse: [resultObj := self positive32BitIntegerFor: value]. ^resultObj! Item was changed: ----- Method: StackInterpreter>>printHex: (in category 'debug printing') ----- printHex: n "Print n in hex, in the form ' 0x1234', padded to a width of 10 characters in 32-bits ('0x' + 8 nibbles) or 18 characters in 64-bits ('0x' + 16 nibbles)" <api> | len buf | <var: #buf declareC: 'char buf[37]'> "large enough for a 64-bit value in hex plus the null plus 16 spaces" self cCode: 'memset(buf,'' '',36)' inSmalltalk: [buf := 'doh!!']. + len := self cCode: 'sprintf(buf + 2 + 2 * BytesPerWord, "0x%" PRIxSQPTR, (usqIntptr_t)(n))'. - len := self cCode: 'sprintf(buf + 2 + 2 * BytesPerWord, "0x%lx", (unsigned long)(n))'. self cCode: 'printf("%s", buf + len)'. len touch: buf! Item was changed: ----- Method: StackInterpreter>>printMethodCacheFor: (in category 'debug printing') ----- printMethodCacheFor: thing <api> | n | n := 0. 0 to: MethodCacheSize - 1 by: MethodCacheEntrySize do: [:i | | s c m p | s := methodCache at: i + MethodCacheSelector. c := methodCache at: i + MethodCacheClass. m := methodCache at: i + MethodCacheMethod. p := methodCache at: i + MethodCachePrimFunction. ((thing = -1 or: [s = thing or: [c = thing or: [p = thing or: [m = thing]]]]) and: [(objectMemory addressCouldBeOop: s) and: [c ~= 0 and: [(self addressCouldBeClassObj: c) or: [self addressCouldBeClassObj: (objectMemory classForClassTag: c)]]]]) ifTrue: [self cCode: [] inSmalltalk: [self transcript ensureCr]. self printNum: i; space; printHexnp: i; cr; tab. (objectMemory isBytesNonImm: s) + ifTrue: [self cCode: 'printf("%" PRIxSQPTR " %.*s\n", s, (int)(numBytesOf(s)), (char *)firstIndexableField(s))' - ifTrue: [self cCode: 'printf("%lx %.*s\n", s, (int)(numBytesOf(s)), (char *)firstIndexableField(s))' inSmalltalk: [self printHex: s; space; print: (self stringOf: s); cr]] ifFalse: [self shortPrintOop: s]. self tab. (self addressCouldBeClassObj: c) ifTrue: [self shortPrintOop: c] ifFalse: [self printNum: c; space; shortPrintOop: (objectMemory classForClassTag: c)]. self tab; shortPrintOop: m; tab. self cCode: [p > 1024 ifTrue: [self printHexnp: p] ifFalse: [self printNum: p]] inSmalltalk: [p isSymbol ifTrue: [self print: p] ifFalse: [self printNum: p]]. self cr]]. n > 1 ifTrue: [self printNum: n; cr]! Item was changed: ----- Method: StackInterpreter>>printOop: (in category 'debug printing') ----- printOop: oop | cls fmt lastIndex startIP bytecodesPerLine column | <inline: false> (objectMemory isImmediate: oop) ifTrue: [^self shortPrintOop: oop]. self printHex: oop. (objectMemory addressCouldBeObj: oop) ifFalse: [^self print: ((oop bitAnd: objectMemory allocationUnit - 1) ~= 0 ifTrue: [' is misaligned'] ifFalse: [self whereIs: oop]); cr]. (objectMemory isFreeObject: oop) ifTrue: [self print: ' is a free chunk of size '; printNum: (objectMemory sizeOfFree: oop). objectMemory hasSpurMemoryManagerAPI ifTrue: [self print: ' 0th: '; printHex: (objectMemory fetchPointer: 0 ofFreeChunk: oop). objectMemory printHeaderTypeOf: oop]. ^self cr]. (objectMemory isForwarded: oop) ifTrue: [self print: ' is a forwarded object to '; printHex: (objectMemory followForwarded: oop); print: ' of slot size '; printNum: (objectMemory numSlotsOfAny: oop). objectMemory printHeaderTypeOf: oop. ^self cr]. self print: ': a(n) '. self printNameOfClass: (cls := objectMemory fetchClassOfNonImm: oop) count: 5. cls = (objectMemory splObj: ClassFloat) ifTrue: [^self cr; printFloat: (objectMemory dbgFloatValueOf: oop); cr]. fmt := objectMemory formatOf: oop. fmt > objectMemory lastPointerFormat ifTrue: [self print: ' nbytes '; printNum: (objectMemory numBytesOf: oop)]. self cr. (fmt between: objectMemory firstLongFormat and: objectMemory firstCompiledMethodFormat - 1) ifTrue: ["This will answer false if splObj: ClassAlien is nilObject" (self is: oop KindOfClass: (objectMemory splObj: ClassAlien)) ifTrue: [self print: ' datasize '; printNum: (self sizeOfAlienData: oop). self print: ((self isIndirectAlien: oop) ifTrue: [' indirect @ '] ifFalse: [(self isPointerAlien: oop) ifTrue: [' pointer @ '] ifFalse: [' direct @ ']]). ^self printHex: (self startOfAlienData: oop) asUnsignedInteger; cr]. (objectMemory isWordsNonImm: oop) ifTrue: [lastIndex := 64 min: ((objectMemory numBytesOf: oop) / objectMemory wordSize). lastIndex > 0 ifTrue: [1 to: lastIndex do: [:index| self space; printHex: (objectMemory fetchLong32: index - 1 ofObject: oop). (index \\ self elementsPerPrintOopLine) = 0 ifTrue: [self cr]]. (lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse: [self cr]]. ^self]. ^self printStringOf: oop; cr]. "this is nonsense. apologies." startIP := (objectMemory lastPointerOf: oop) + objectMemory bytesPerOop - objectMemory baseHeaderSize / objectMemory bytesPerOop. lastIndex := 256 min: startIP. lastIndex > 0 ifTrue: [1 to: lastIndex do: [:index| self cCode: [self printHex: (objectMemory fetchPointer: index - 1 ofObject: oop); space] inSmalltalk: [self space; printHex: (objectMemory fetchPointer: index - 1 ofObject: oop); space. self print: (self shortPrint: (objectMemory fetchPointer: index - 1 ofObject: oop))]. (index \\ self elementsPerPrintOopLine) = 0 ifTrue: [self cr]]. (lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse: [self cr]]. (objectMemory isCompiledMethod: oop) ifFalse: [startIP > 64 ifTrue: [self print: '...'; cr]] ifTrue: [startIP := startIP * objectMemory wordSize + 1. lastIndex := objectMemory lengthOf: oop. lastIndex - startIP > 100 ifTrue: [lastIndex := startIP + 100]. bytecodesPerLine := 8. column := 1. startIP to: lastIndex do: [:index| | byte | column = 1 ifTrue: + [self cCode: 'printf("0x%08" PRIxSQPTR ": ", (usqIntptr_t)(oop+BaseHeaderSize+index-1))' - [self cCode: 'printf("0x%08lx: ", (unsigned long)(oop+BaseHeaderSize+index-1))' inSmalltalk: [self print: (oop+objectMemory baseHeaderSize+index-1) hex; print: ': ']]. byte := objectMemory fetchByte: index - 1 ofObject: oop. self cCode: 'printf(" %02x/%-3d", (int)byte,(int)byte)' inSmalltalk: [self space; print: (byte radix: 16); printChar: $/; printNum: byte]. column := column + 1. column > bytecodesPerLine ifTrue: [column := 1. self cr]]. column = 1 ifFalse: [self cr]]! Item was changed: ----- Method: StackInterpreter>>rewriteMethodCacheEntryForExternalPrimitiveToFunction: (in category 'method lookup cache') ----- rewriteMethodCacheEntryForExternalPrimitiveToFunction: localPrimAddress "Rewrite an existing entry in the method cache with a new primitive function address. Used by primitiveExternalCall to make direct calls to found external prims, or quickly fail not found external prims." <inline: false> <var: #localPrimAddress declareC: 'void (*localPrimAddress)(void)'> (methodCache at: lastMethodCacheProbeWrite + MethodCacheMethod) = newMethod ifTrue: [methodCache at: lastMethodCacheProbeWrite + MethodCachePrimFunction + put: (self cCoerce: localPrimAddress to: #'sqIntptr_t')]! - put: (self cCoerce: localPrimAddress to: #long)]! Item was changed: ----- Method: StackInterpreter>>stackPositiveMachineIntegerValue: (in category 'stack access') ----- stackPositiveMachineIntegerValue: offset <api> + <returnTypeC: #'usqIntptr_t'> "In the StackInterpreter stacks grow down." | integerPointer | integerPointer := stackPages longAt: stackPointer + (offset*objectMemory wordSize). ^self positiveMachineIntegerValueOf: integerPointer! Item was changed: ----- Method: StackInterpreter>>stackSignedMachineIntegerValue: (in category 'stack access') ----- stackSignedMachineIntegerValue: offset <api> + <returnTypeC: #'sqIntptr_t'> "In the StackInterpreter stacks grow down." | integerPointer | integerPointer := stackPages longAt: stackPointer + (offset*objectMemory wordSize). ^self signedMachineIntegerValueOf: integerPointer! Item was changed: ----- Method: ThreadedFFIPlugin>>ffiAddressOf:startingAt:size: (in category 'primitive support') ----- ffiAddressOf: rcvr startingAt: byteOffset size: byteSize "Answer a long of the address of the byteSize slot (byte, short, int, whatever) at byteOffset in rcvr. Nominally intended for use with ExternalAddress objects, this code will work (for obscure historical reasons) with plain Byte or Word Arrays as well. " | rcvrClass rcvrSize addr | (interpreterProxy isBytes: rcvr) ifFalse:[^interpreterProxy primitiveFail]. byteOffset > 0 ifFalse:[^interpreterProxy primitiveFail]. rcvrClass := interpreterProxy fetchClassOf: rcvr. rcvrSize := interpreterProxy byteSizeOf: rcvr. rcvrClass = interpreterProxy classExternalAddress ifTrue: [rcvrSize = BytesPerWord ifFalse:[^interpreterProxy primitiveFail]. addr := interpreterProxy fetchPointer: 0 ofObject: rcvr. "Hack!!!!" "don't you dare to read from object memory (unless is pinned)!!" (addr = 0 "or: [(interpreterProxy isInMemory: addr) or: [(interpreterProxy isPinned: rcvr) not]]") ifTrue: [^interpreterProxy primitiveFail]] ifFalse: [byteOffset+byteSize-1 <= rcvrSize ifFalse: [^interpreterProxy primitiveFail]. + addr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'sqIntptr_t']. - addr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #long]. addr := addr + byteOffset - 1. ^addr! Item was changed: ----- Method: ThreadedFFIPlugin>>ffiLoadCalloutAddress: (in category 'symbol loading') ----- ffiLoadCalloutAddress: lit "Load the address of the foreign function from the given object" | addressPtr address ptr | + <var: #ptr type: #'sqIntptr_t *'> - <var: #ptr type: #'long *'> "Lookup the address" addressPtr := interpreterProxy fetchPointer: 0 ofObject: lit. "Make sure it's an external handle" address := self ffiContentsOfHandle: addressPtr errCode: FFIErrorBadAddress. interpreterProxy failed ifTrue: [^0]. address = 0 ifTrue:"Go look it up in the module" [self externalFunctionHasStackSizeSlot ifTrue: [interpreterProxy storePointer: ExternalFunctionStackSizeIndex ofObject: lit withValue: (interpreterProxy integerObjectOf: -1)]. (interpreterProxy slotSizeOf: lit) < 5 ifTrue: [^self ffiFail: FFIErrorNoModule]. address := self ffiLoadCalloutAddressFrom: lit. interpreterProxy failed ifTrue: [^0]. "Store back the address" ptr := interpreterProxy firstIndexableField: addressPtr. ptr at: 0 put: address]. ^address! Item was changed: ----- Method: ThreadedFFIPlugin>>primitiveFFIAllocate (in category 'primitives') ----- primitiveFFIAllocate "Primitive. Allocate an object on the external heap." | byteSize addr oop ptr | <export: true> <inline: false> + <var: #ptr type: #'sqIntptr_t *'> - <var: #ptr type: #'long *'> byteSize := interpreterProxy stackIntegerValue: 0. interpreterProxy failed ifTrue: [^nil]. addr := self ffiAlloc: byteSize. addr = 0 ifTrue: [^interpreterProxy primitiveFail]. oop := interpreterProxy instantiateClass: interpreterProxy classExternalAddress + indexableSize: (self sizeof: #'sqIntptr_t'). - indexableSize: (self sizeof: #long). ptr := interpreterProxy firstIndexableField: oop. ptr at: 0 put: addr. ^interpreterProxy pop: 2 thenPush: oop! Item was changed: ----- Method: ThreadedFFIPlugin>>primitiveFFIFree (in category 'primitives') ----- primitiveFFIFree "Primitive. Free the object pointed to on the external heap." | addr oop ptr | <export: true> <inline: false> + <var: #ptr type: #'sqIntptr_t *'> - <var: #ptr type: #'long *'> oop := interpreterProxy stackObjectValue: 0. ((interpreterProxy fetchClassOf: oop) = interpreterProxy classExternalAddress + and: [(interpreterProxy byteSizeOf: oop) = (self sizeof: #'sqIntptr_t')]) ifFalse: - and: [(interpreterProxy byteSizeOf: oop) = (self sizeof: #long)]) ifFalse: [^interpreterProxy primitiveFail]. ptr := interpreterProxy firstIndexableField: oop. addr := ptr at: 0. "Don't you dare to free Squeak's memory!!" (addr = 0 + or: [(addr asUnsignedIntegerPtr bitAnd: (self sizeof: #'sqIntptr_t') - 1) ~= 0 - or: [(addr asUnsignedLong bitAnd: (self sizeof: #long) - 1) ~= 0 or: [interpreterProxy isInMemory: addr]]) ifTrue: [^interpreterProxy primitiveFail]. self ffiFree: addr. ^ptr at: 0 put: 0 "cleanup"! Item was changed: ----- Method: ThreadedFFIPlugin>>primitiveSetManualSurfacePointer (in category 'primitives - surfaces') ----- primitiveSetManualSurfacePointer "Create a 'manual surface' data-structure. See the ExternalForm class in the FFI package for example usage." "arguments: name(type, stack offset) surfaceID(Integer, 1) ptr(uint32/uint64, 0)" | surfaceID ptr result | <export: true> + <var: #ptr type: #'usqIntptr_t'> - <var: #ptr type: #'unsigned long'> interpreterProxy methodArgumentCount = 2 ifFalse: [^interpreterProxy primitiveFail]. surfaceID := interpreterProxy stackIntegerValue: 1. ptr := interpreterProxy positiveMachineIntegerValueOf: (interpreterProxy stackValue: 0). interpreterProxy failed ifTrue: [^nil]. self touch: surfaceID; touch: ptr. result := self setManualSurface: surfaceID Pointer: ptr asVoidPointer. result = 0 ifTrue: [^interpreterProxy primitiveFail]. ^interpreterProxy pop: 2 ! Item was removed: - ----- Method: ThreadedX64FFIPlugin class>>excludingPredefinedMacros (in category 'translation') ----- - excludingPredefinedMacros - "Answer the predefined macros that disqualify the platforms a subclass handles, if any. - This can be used to differentiate e.g. x64 Sys V from x64 Win64." - ^#('WIN64')! Item was changed: ----- Method: Unsigned class>>ccgDeclareCForVar: (in category 'plugin generation') ----- ccgDeclareCForVar: aSymbolOrString + ^'usqIntptr_t ', aSymbolOrString! - ^'unsigned long ', aSymbolOrString! Item was changed: ----- Method: VMCallbackContext class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') ----- instVarNamesAndTypesForTranslationDo: aBinaryBlock "Define a CallbackContext, the argument to sendInvokeCallbackContext: self typedef" self instVarNames do: [:ivn| aBinaryBlock value: ivn value: (ivn caseOf: { ['thunkp'] -> [#'void *']. + ['stackp'] -> [#'sqIntptr_t *']. + ['intregargsp'] -> [#'sqIntptr_t *']. - ['stackp'] -> [#'long *']. - ['intregargsp'] -> [#'long *']. ['floatregargsp'] -> [#'double *']. ['rvs'] -> [ 'union { + sqIntptr_t valword; - long valword; struct { int low, high; } valleint64; struct { int high, low; } valbeint64; double valflt64; + struct { void *addr; sqIntptr_t size; } valstruct; - struct { void *addr; long size; } valstruct; }']. ['savedCStackPointer'] -> [#'void *']. ['savedCFramePointer'] -> [#'void *']. ['trampoline'] -> [#'jmp_buf']. ['savedReenterInterpreter'] -> [#'jmp_buf']})]! Item was changed: ----- Method: VMProfileLinuxSupportPlugin>>primitiveDLSymInLibrary (in category 'primitives') ----- primitiveDLSymInLibrary "Answer the address of the symbol whose name is the first argument in the library whose name is the second argument, or nil if none." | nameObj symName libName lib sz addr ok | <export: true> <var: #symName type: #'char *'> <var: #libName type: #'char *'> <var: #lib type: #'void *'> <var: #addr type: #'void *'> nameObj := interpreterProxy stackValue: 0. (interpreterProxy isBytes: nameObj) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. sz := interpreterProxy byteSizeOf: nameObj. libName := self malloc: sz+1. self st: libName rn: (interpreterProxy firstIndexableField: nameObj) cpy: sz. libName at: sz put: 0. nameObj := interpreterProxy stackValue: 1. (interpreterProxy isBytes: nameObj) ifFalse: [self free: libName. ^interpreterProxy primitiveFailFor: PrimErrBadArgument]. sz := interpreterProxy byteSizeOf: nameObj. symName := self malloc: sz+1. self st: symName rn: (interpreterProxy firstIndexableField: nameObj) cpy: sz. symName at: sz put: 0. lib := self dl: libName open: (#'RTLD_LAZY' bitOr: #'RTLD_NODELETE'). lib ifNil: [self free: libName; free: symName. ^interpreterProxy primitiveFailFor: PrimErrInappropriate]. self dlerror. "clear dlerror" addr := self dl: lib sym: symName. ok := self dlerror isNil. self free: symName. self free: libName. self dlclose: lib. ok ifFalse: [^interpreterProxy primitiveFailFor: PrimErrNotFound]. + ^interpreterProxy methodReturnValue: (interpreterProxy positiveMachineIntegerFor: addr asUnsignedIntegerPtr)! - ^interpreterProxy methodReturnValue: (interpreterProxy positiveMachineIntegerFor: addr asUnsignedLong)! Item was changed: ----- Method: VMProfileLinuxSupportPlugin>>primitiveInterpretAddress (in category 'primitives') ----- primitiveInterpretAddress "Answer the address of the interpret routine." <export: true> | interpret | <var: #interpret declareC: 'extern void interpret()'> + ^interpreterProxy methodReturnValue: (interpreterProxy positiveMachineIntegerFor: interpret asUnsignedIntegerPtr)! - ^interpreterProxy methodReturnValue: (interpreterProxy positiveMachineIntegerFor: interpret asUnsignedLong)! Item was changed: ----- Method: VMProfileMacSupportPlugin>>primitiveDLSym (in category 'primitives') ----- primitiveDLSym "Answer the address of the argument in the current process or nil if none." | nameObj name namePtr sz addr | <export: true> <var: #name type: #'char *'> <var: #namePtr type: #'char *'> <var: #addr type: #'void *'> nameObj := interpreterProxy stackValue: 0. (interpreterProxy isBytes: nameObj) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. sz := interpreterProxy byteSizeOf: nameObj. name := self malloc: sz+1. namePtr := interpreterProxy firstIndexableField: nameObj. 0 to: sz-1 do:[:i| name at: i put: (namePtr at: i)]. name at: sz put: 0. addr := self cCode: 'dlsym(RTLD_SELF,name)' inSmalltalk: [0]. self free: name. ^interpreterProxy methodReturnValue: (addr = 0 ifTrue: [interpreterProxy nilObject] + ifFalse: [interpreterProxy positiveMachineIntegerFor: addr asUnsignedIntegerPtr])! - ifFalse: [interpreterProxy positiveMachineIntegerFor: addr asUnsignedLong])! Item was changed: ----- Method: VMProfileMacSupportPlugin>>primitiveExecutableModulesAndOffsets (in category 'primitives') ----- primitiveExecutableModulesAndOffsets "Answer an Array of quads for executable modules (the VM executable and loaded libraries). Each quad is the module's name, its vm address relocation in memory, the (unrelocated) start address, and the size." | nimages resultObj name valueObj nameObjData slide start size | <export: true> <var: #name type: 'const char *'> <var: #nameObjData type: #'char *'> <var: #h type: 'const struct mach_header *'> <var: #h64 type: 'const struct mach_header_64 *'> <var: #s64 type: 'const struct section_64 *'> <var: #s type: 'const struct section *'> + <var: #start type: 'usqIntptr_t'> + <var: #slide type: 'usqIntptr_t'> + <var: #size type: 'usqIntptr_t'> - <var: #start type: 'unsigned long'> - <var: #slide type: 'unsigned long'> - <var: #size type: 'unsigned long'> self cppIf: #'MAC_OS_X_VERSION_MIN_REQUIRED' <= #'MAC_OS_X_VERSION_10_4' ifTrue: "_dyld_present was deprecated in 10.5" [(self cCode: '_dyld_present()' inSmalltalk: false) ifFalse: [^interpreterProxy primitiveFail]]. nimages := self cCode: '_dyld_image_count()' inSmalltalk: 0. resultObj := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: nimages * 4. resultObj = 0 ifTrue: [^interpreterProxy primitiveFail]. interpreterProxy pushRemappableOop: resultObj. 0 to: nimages - 1 do: [:i| start := size := -1. "impossible start & size" name := self cCode: '_dyld_get_image_name(i)' inSmalltalk: 0. slide := self cCode: '_dyld_get_image_vmaddr_slide(i)' inSmalltalk: 0. self cppIf: #'__x86_64__' ifTrue: [(self cCode: '(const struct mach_header_64 *)_dyld_get_image_header(i)' inSmalltalk: nil) ifNotNil: [:h64| (self cCode: 'getsectbynamefromheader_64(h64,SEG_TEXT,SECT_TEXT)' inSmalltalk: nil) ifNotNil: [:s64| start := self cCode: 's64->addr' inSmalltalk: 0. size := self cCode: 's64->size' inSmalltalk: 0]]] ifFalse: [(self cCode: '_dyld_get_image_header(i)' inSmalltalk: nil) ifNotNil: [:h| (self cCode: 'getsectbynamefromheader(h,SEG_TEXT,SECT_TEXT)' inSmalltalk: nil) ifNotNil: [:s| start := self cCode: 's->addr' inSmalltalk: 0. size := self cCode: 's->size' inSmalltalk: 0]]]. valueObj := interpreterProxy instantiateClass: interpreterProxy classString indexableSize: (self strlen: name). interpreterProxy failed ifTrue: [interpreterProxy popRemappableOop. ^interpreterProxy primitiveFail]. interpreterProxy storePointer: i * 4 ofObject: interpreterProxy topRemappableOop withValue: valueObj. nameObjData := interpreterProxy arrayValueOf: valueObj. self mem: nameObjData cp: name y: (self strlen: name). valueObj := interpreterProxy signedMachineIntegerFor: slide. interpreterProxy failed ifTrue: [interpreterProxy popRemappableOop. ^interpreterProxy primitiveFail]. interpreterProxy storePointer: i * 4 + 1 ofObject: interpreterProxy topRemappableOop withValue: valueObj. valueObj := interpreterProxy positiveMachineIntegerFor: start. interpreterProxy failed ifTrue: [interpreterProxy popRemappableOop. ^interpreterProxy primitiveFail]. interpreterProxy storePointer: i * 4 + 2 ofObject: interpreterProxy topRemappableOop withValue: valueObj. valueObj := interpreterProxy positiveMachineIntegerFor: size. interpreterProxy failed ifTrue: [interpreterProxy popRemappableOop. ^interpreterProxy primitiveFail]. interpreterProxy storePointer: i * 4 + 3 ofObject: interpreterProxy topRemappableOop withValue: valueObj]. resultObj := interpreterProxy popRemappableOop. ^interpreterProxy pop: 1 thenPush: resultObj!

1 0

[OpenSmalltalk/opensmalltalk-vm]
by GitHub 06 Nov '16

06 Nov '16

Branch: refs/heads/smalltalkCI Home: https://github.com/OpenSmalltalk/opensmalltalk-vm

1 0

[OpenSmalltalk/opensmalltalk-vm] ddbebd: Run Squeak/Pharo SUnit tests via smalltalkCI
by GitHub 06 Nov '16

06 Nov '16

Branch: refs/heads/smalltalkCI Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: ddbebd51a1c76cb444d8b61c7a2d083bc469e532 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/ddbebd51a1c76cb444… Author: Fabio Niephaus <code(a)fniephaus.com> Date: 2016-11-06 (Sun, 06 Nov 2016) Changed paths: M .travis_install.sh M .travis_test.sh A tests/smalltalk.ston A tests/smalltalkCI.sh Log Message: ----------- Run Squeak/Pharo SUnit tests via smalltalkCI Commit: 2f56e2122a11203f0d074870d82e17926047e239 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/2f56e2122a11203f0d… Author: Fabio Niephaus <code(a)fniephaus.com> Date: 2016-11-06 (Sun, 06 Nov 2016) Changed paths: M tests/smalltalkCI.sh Log Message: ----------- Debug Commit: c0b4f6dac8f3af68d7ccd4961eb1aa000be07c48 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/c0b4f6dac8f3af68d7… Author: Fabio Niephaus <code(a)fniephaus.com> Date: 2016-11-06 (Sun, 06 Nov 2016) Changed paths: M tests/smalltalk.ston M tests/smalltalkCI.sh Log Message: ----------- 32bit only, blacklist test case Compare: https://github.com/OpenSmalltalk/opensmalltalk-vm/compare/ddbebd51a1c7^...c…

1 0

[OpenSmalltalk/opensmalltalk-vm]
by GitHub 06 Nov '16

06 Nov '16

Branch: refs/heads/smalltalkCI Home: https://github.com/OpenSmalltalk/opensmalltalk-vm

1 0

[OpenSmalltalk/opensmalltalk-vm] ddbebd: Run Squeak/Pharo SUnit tests via smalltalkCI
by GitHub 06 Nov '16

06 Nov '16

Branch: refs/heads/smalltalkCI Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: ddbebd51a1c76cb444d8b61c7a2d083bc469e532 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/ddbebd51a1c76cb444… Author: Fabio Niephaus <code(a)fniephaus.com> Date: 2016-11-06 (Sun, 06 Nov 2016) Changed paths: M .travis_install.sh M .travis_test.sh A tests/smalltalk.ston A tests/smalltalkCI.sh Log Message: ----------- Run Squeak/Pharo SUnit tests via smalltalkCI Commit: 2f56e2122a11203f0d074870d82e17926047e239 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/2f56e2122a11203f0d… Author: Fabio Niephaus <code(a)fniephaus.com> Date: 2016-11-06 (Sun, 06 Nov 2016) Changed paths: M tests/smalltalkCI.sh Log Message: ----------- Debug Compare: https://github.com/OpenSmalltalk/opensmalltalk-vm/compare/ddbebd51a1c7^...2…

1 0

VM Maker: VMMaker.oscog-nice.1981.mcz
by commits＠source.squeak.org 06 Nov '16

06 Nov '16

Nicolas Cellier uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-nice.1981.mcz ==================== Summary ==================== Name: VMMaker.oscog-nice.1981 Author: nice Time: 6 November 2016, 2:27:26.75858 pm UUID: b8675b17-30ec-479d-977d-bc2c6c9aa941 Ancestors: VMMaker.oscog-nice.1980 reportMinimumUnusedHeadroom with %lld format. That's superfluous in 32 bits, but does not hurt, and it works correctly in LLP64 contrarily to %ld. The alternative of using PRIdSQPTR macro would be overkill here. Review usage of long/unsigned long type hints that should better be replaced with sqInt/usqInt because the intention is to handle a oop, not a target machine address. Same with senders of asUnsignedLong, some should be replaced with asUnsignedInteger (that is a cast to usqInt), typically after longAt: because longAt: returns an oop (a sqInt). Let #'sqIntptr_t' #'usqIntptr_t' types be "isFunctional" to allow inlining in C code generator. =============== Diff against VMMaker.oscog-nice.1980 =============== Item was changed: ----- Method: CoInterpreter>>reportMinimumUnusedHeadroom (in category 'debug support') ----- reportMinimumUnusedHeadroom "Report the stack page size and minimum unused headroom to stdout." <api> self cCode: + [self pri: 'stack page bytes %lld available headroom %lld minimum unused headroom %lld\n' + n: self stackPageByteSize asUnsignedLongLong + t: (self stackPageByteSize - self stackLimitBytes - self stackLimitOffset) asUnsignedLongLong + f: self minimumUnusedHeadroom asUnsignedLongLong] - [self pri: 'stack page bytes %ld available headroom %ld minimum unused headroom %ld\n' - n: self stackPageByteSize asLong - t: (self stackPageByteSize - self stackLimitBytes - self stackLimitOffset) asLong - f: self minimumUnusedHeadroom asLong] inSmalltalk: ["CogVMSimulator new initStackPagesForTests reportMinimumUnusedHeadroom" self print: 'stack page bytes '; printNum: self stackPageByteSize; print: ' available headroom '; printNum: self stackPageByteSize - self stackLimitBytes - self stackLimitOffset; print: ' minimum unused headroom '; printNum: self minimumUnusedHeadroom; cr]! Item was changed: ----- Method: CogIA32Compiler>>concretizeFill32 (in category 'generate machine code') ----- concretizeFill32 <inline: true> | word | + <var: #word type: #'usqIntptr_t'> - <var: #word type: #'unsigned long'> word := operands at: 0. machineCode at: 0 put: (word bitAnd: 16rFF). machineCode at: 1 put: (word >> 8 bitAnd: 16rFF). machineCode at: 2 put: (word >> 16 bitAnd: 16rFF). machineCode at: 3 put: (word >> 24 bitAnd: 16rFF). ^machineCodeSize := 4! Item was changed: ----- Method: CogIA32Compiler>>isQuick: (in category 'testing') ----- isQuick: operand + <var: #operand type: #'usqIntptr_t'> - <var: #operand type: #'unsigned long'> ^operand signedIntFromLong between: -128 and: 127! Item was changed: ----- Method: CogX64Compiler>>concretizeFill32 (in category 'generate machine code') ----- concretizeFill32 <inline: true> | word | + <var: #word type: #'usqIntptr_t'> - <var: #word type: #'unsigned long'> word := operands at: 0. machineCode at: 0 put: (word bitAnd: 16rFF). machineCode at: 1 put: (word >> 8 bitAnd: 16rFF). machineCode at: 2 put: (word >> 16 bitAnd: 16rFF). machineCode at: 3 put: (word >> 24 bitAnd: 16rFF). ^machineCodeSize := 4! Item was changed: ----- Method: InterpreterPrimitives>>asUnsigned: (in category 'primitive support') ----- asUnsigned: anInteger <inline: true> + ^self cCode: [anInteger asUnsignedInteger] inSmalltalk: [anInteger bitAnd: objectMemory maxCInteger]! - ^self cCode: [anInteger asUnsignedLong] inSmalltalk: [anInteger bitAnd: objectMemory maxCInteger]! Item was changed: ----- Method: LargeIntegersPlugin>>normalizeNegative: (in category 'oop functions') ----- normalizeNegative: aLargeNegativeInteger "Check for leading zeroes and return shortened copy if so." "First establish len = significant length." | val val2 sLen digitLen byteLen oldByteLen minVal | + <var: #val type: #usqInt> + <var: #val2 type: #usqInt> + <var: #minVal type: #usqInt> - <var: #val type: #'unsigned long'> - <var: #val2 type: #'unsigned long'> - <var: #minVal type: #'unsigned long'> digitLen := self digitSizeOfLargeInt: aLargeNegativeInteger. [digitLen ~= 0 and: [(self unsafeDigitOfLargeInt: aLargeNegativeInteger at: digitLen) = 0]] whileTrue: [digitLen := digitLen - 1]. digitLen = 0 ifTrue: [^ 0 asOop: SmallInteger]. "Now check if in SmallInteger range" val := self unsafeDigitOfLargeInt: aLargeNegativeInteger at: digitLen. sLen := interpreterProxy minSmallInteger < -16r40000000 ifTrue: [2] ifFalse: [1]. "SmallInteger minVal digitLength" digitLen <= sLen ifTrue: [minVal := 0 - interpreterProxy minSmallInteger. val2 := val. digitLen > 1 ifTrue: [val2 := val2 << 32 + (self unsafeDigitOfLargeInt: aLargeNegativeInteger at: 1)]. val2 <= minVal ifTrue: [^0 - val2 asOop: SmallInteger]]. "Return self, or a shortened copy" byteLen := digitLen * 4. val <= 16rFFFF ifTrue: [byteLen := byteLen - 2] ifFalse: [val := val >> 16]. val <= 16rFF ifTrue: [byteLen := byteLen - 1]. oldByteLen := self byteSizeOfLargeInt: aLargeNegativeInteger. byteLen < oldByteLen ifTrue: [^ self largeInt: aLargeNegativeInteger growTo: byteLen] ifFalse: [^ aLargeNegativeInteger]! Item was changed: ----- Method: LargeIntegersPlugin>>normalizePositive: (in category 'oop functions') ----- normalizePositive: aLargePositiveInteger "Check for leading zeroes and return shortened copy if so." "First establish len = significant length." | val val2 sLen digitLen byteLen oldByteLen maxVal | + <var: #val type: #usqInt> + <var: #val2 type: #usqInt> + <var: #maxVal type: #usqInt> - <var: #val type: #'unsigned long'> - <var: #val2 type: #'unsigned long'> - <var: #maxVal type: #'unsigned long'> digitLen := self digitSizeOfLargeInt: aLargePositiveInteger. [digitLen ~= 0 and: [(self unsafeDigitOfLargeInt: aLargePositiveInteger at: digitLen) = 0]] whileTrue: [digitLen := digitLen - 1]. digitLen = 0 ifTrue: [^ 0 asOop: SmallInteger]. "Now check if in SmallInteger range" val := self unsafeDigitOfLargeInt: aLargePositiveInteger at: digitLen. sLen := interpreterProxy maxSmallInteger > 16r3FFFFFFF ifTrue: [2] ifFalse: [1]. "SmallInteger maxVal digitLength" digitLen <= sLen ifTrue: [maxVal := interpreterProxy maxSmallInteger. val2 := val. digitLen > 1 ifTrue: [val2 := val2 << 32 + (self unsafeDigitOfLargeInt: aLargePositiveInteger at: 1)]. val2 <= maxVal ifTrue: [^val2 asOop: SmallInteger]]. "Return self, or a shortened copy" byteLen := digitLen * 4. val <= 16rFFFF ifTrue: [byteLen := byteLen - 2] ifFalse: [val := val >> 16]. val <= 16rFF ifTrue: [byteLen := byteLen - 1]. oldByteLen := self byteSizeOfLargeInt: aLargePositiveInteger. byteLen < oldByteLen ifTrue: [^ self largeInt: aLargePositiveInteger growTo: byteLen] ifFalse: [^ aLargePositiveInteger]! Item was changed: ----- Method: Spur64BitMemoryManager>>oldRawNumSlotsOf: (in category 'object access') ----- oldRawNumSlotsOf: objOop <returnTypeC: #usqInt> <inline: true> + ^(self longAt: objOop) asUnsignedInteger >> self numSlotsFullShift! - ^(self longAt: objOop) asUnsignedLong >> self numSlotsFullShift! Item was changed: ----- Method: Spur64BitMemoryManager>>rawOverflowSlotsOf: (in category 'object access') ----- rawOverflowSlotsOf: objOop <returnTypeC: #usqLong> <inline: true> self flag: #endianness. ^self + cCode: [((self longAt: objOop - self baseHeaderSize) << 8) asUnsignedInteger >> 8] - cCode: [((self longAt: objOop - self baseHeaderSize) << 8) asUnsignedLong >> 8] inSmalltalk: [(self longAt: objOop - self baseHeaderSize) bitAnd: 16rFFFFFFFFFFFFFF]! Item was changed: ----- Method: Spur64BitMemoryManager>>rotateRight: (in category 'interpreter access') ----- rotateRight: anInteger + ^(self cCode: [anInteger] inSmalltalk: [anInteger bitAnd: 1]) << 63 + (anInteger asUnsignedInteger >> 1)! - ^(self cCode: [anInteger] inSmalltalk: [anInteger bitAnd: 1]) << 63 + (anInteger asUnsignedLong >> 1)! Item was changed: ----- Method: SpurMemoryManager>>byteSizeOfInstanceOf:withIndexableSlots:errInto: (in category 'indexing primitive support') ----- byteSizeOfInstanceOf: classObj withIndexableSlots: nElements errInto: errorBlock | instSpec classFormat numSlots | <var: 'numSlots' type: #usqInt> classFormat := self formatOfClass: classObj. instSpec := self instSpecOfClassFormat: classFormat. instSpec caseOf: { [self arrayFormat] -> [numSlots := nElements]. [self indexablePointersFormat] -> [numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements]. [self weakArrayFormat] -> [numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements]. [self sixtyFourBitIndexableFormat] -> [numSlots := self bytesPerOop = 4 ifTrue: [nElements * 2] ifFalse: [nElements]]. [self firstLongFormat] -> [numSlots := self bytesPerOop = 4 ifTrue: [nElements] ifFalse: [nElements + 1 // 2]]. [self firstShortFormat] -> [numSlots := self bytesPerOop = 4 ifTrue: [nElements + 1 // 2] ifFalse: [nElements + 3 // 4]]. [self firstByteFormat] -> [numSlots := nElements + (self bytesPerOop - 1) // self bytesPerOop]. [self firstCompiledMethodFormat] -> "Assume nElements is derived from CompiledMethod>>basicSize." [numSlots := nElements + (self bytesPerOop - 1) // self bytesPerOop] } otherwise: [^errorBlock value: PrimErrBadReceiver negated]. "non-indexable" + numSlots >= (1 asUnsignedInteger << (self bytesPerOop * 8 - self logBytesPerOop)) ifTrue: - numSlots >= (1 asLong << (self bytesPerOop * 8 - self logBytesPerOop)) ifTrue: [^errorBlock value: (nElements < 0 ifTrue: [PrimErrBadArgument] ifFalse: [PrimErrLimitExceeded])]. ^self objectBytesForSlots: numSlots! Item was changed: ----- Method: StackInterpreter>>positive32BitIntegerFor: (in category 'primitive support') ----- positive32BitIntegerFor: integerValue "integerValue is interpreted as POSITIVE, e.g. as the result of Bitmap>at:. N.B. Returning in each arm separately enables Slang inlining. /Don't/ return the ifTrue:ifFalse: unless Slang inlining of conditionals is fixed." <inline: true> <var: 'integerValue' type: #'unsigned int'> objectMemory hasSixtyFourBitImmediates ifTrue: + [^objectMemory integerObjectOf: (integerValue asUnsignedInteger bitAnd: 16rFFFFFFFF)] - [^objectMemory integerObjectOf: (integerValue asUnsignedLong bitAnd: 16rFFFFFFFF)] ifFalse: [^self maybeInlinePositive32BitIntegerFor: integerValue]! Item was changed: ----- Method: StackInterpreter>>putLong:toFile: (in category 'image save/restore') ----- putLong: aLong toFile: aFile "Append aLong to aFile in this platform's 'natural' byte order. aLong is either 32 or 64 bits, depending on ObjectMemory. (Bytes will be swapped, if necessary, when the image is read on a different platform.) Set successFlag to false if the write fails." + <var: #aLong type: #sqInt> - <var: #aLong type: #long> <var: #aFile type: #sqImageFile> <inline: false> | objectsWritten | objectsWritten := self + cCode: [self sq: (self addressOf: aLong) Image: (self sizeof: #sqInt) File: 1 Write: aFile] - cCode: [self sq: (self addressOf: aLong) Image: (self sizeof: #long) File: 1 Write: aFile] inSmalltalk: [| value | value := aLong. objectMemory wordSize timesRepeat: [aFile nextPut: (value bitAnd: 16rFF). value := value >> 8]. 1]. self success: objectsWritten = 1! Item was changed: ----- Method: TMethod>>isFunctional (in category 'inlining') ----- isFunctional "Answer true if the receiver is a functional method. That is, if it consists of a single return statement of an expression that contains no other returns. Answer false for methods with return types other than the simple integer types to work around bugs in the inliner." parseTree statements isEmpty ifTrue: [^false]. parseTree statements last isReturn ifFalse: [^false]. parseTree statements size = 1 ifFalse: [(parseTree statements size = 2 and: [parseTree statements first isSend and: [parseTree statements first selector == #flag:]]) ifFalse: [^false]]. parseTree statements last expression nodesDo: [ :n | n isReturn ifTrue: [^false]]. ^#(int #'unsigned int' #long #'unsigned long' #'long long' #'unsigned long long' + sqInt usqInt #'sqIntptr_t' #'usqIntptr_t' sqLong usqLong - sqInt usqInt sqLong usqLong #'int *' #'unsigned int *' #'sqInt *' #'usqInt *' #'sqLong *' #'usqLong *' #'CogMethod *' #'char *') includes: returnType!

1 0

Re: [Vm-dev] [Pharo-users] Forgive me
by Robert Withers 06 Nov '16

06 Nov '16

Thank you. It breaks my heart I'm who I am, so at odds with who I wish to be. Cave shadowz and distorted viewpoints. On 11/6/2016 2:56 AM, phil(a)highoctane.be wrote: > You are forgiven. > > Now get back to delivering us awesome features. > > Namaste. > Phil > > On Sun, Nov 6, 2016 at 8:24 AM, Robert Withers > <robert.w.withers(a)gmail.com <mailto:robert.w.withers@gmail.com>> wrote: > > Forgive me for being such a huge unbearable fucking asshole. > > > >

1 0

VM Maker: VMMaker.oscog-nice.1979.mcz
by commits＠source.squeak.org 04 Nov '16

04 Nov '16

Nicolas Cellier uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-nice.1979.mcz ==================== Summary ==================== Name: VMMaker.oscog-nice.1979 Author: nice Time: 4 November 2016, 9:58:00.806651 pm UUID: 2abf6236-cd7c-42c2-bf82-515ac9ada054 Ancestors: VMMaker.oscog-nice.1978 Introduce sqIntptr_t and usqIntptr_t in VMMaker (image side) for LLP64 compatibility - but do not yet use them. These are integers long enough to hold a target machine pointer (BytesPerWord). These should later replace most usage of #long and #'unsigned long'. They are already defined in sqMemoryAccess.h. Add enough machinery for generating and simulating these types, inferring size, converting signedness etc.... Introduce asUnsignedIntegerPtr which will convert to (cast to) a usqIntptr_t. same for asIntegerPtr -> sqIntptr_t. They should replace most usage of asUnsignedLong and asLong in the future. Unless we don't want a machine word, but an oop, in which case we should use asUnsignedInteger (-> usqInt) or asInteger (-> sqInt) (typically to turn a longAt: into an unsignedLongAt: - because longAt: answers a sqInt not a long!) Restore the size of sqInt/usqInt as BytePerOop. BytesPerOop matches BytesPerWord for Spur currently, but the CCodeGenerator should be Spur-agnostic if possible. Move sqInt/usqInt check ahead in simulated sizeof: because most variables are of this type. =============== Diff against VMMaker.oscog-eem.1977 =============== Item was added: + ----- Method: CCodeGenerator>>generateAsIntegerPtr:on:indent: (in category 'C translation') ----- + generateAsIntegerPtr: msgNode on: aStream indent: level + "Generate the C code for this message onto the given stream." + + aStream nextPutAll:'((sqIntptr_t)'. + self emitCExpression: msgNode receiver on: aStream. + aStream nextPut: $)! Item was added: + ----- Method: CCodeGenerator>>generateAsUnsignedIntegerPtr:on:indent: (in category 'C translation') ----- + generateAsUnsignedIntegerPtr: msgNode on: aStream indent: level + "Generate the C code for this message onto the given stream." + + aStream nextPutAll:'((usqIntptr_t)'. + self emitCExpression: msgNode receiver on: aStream. + aStream nextPut: $)! Item was changed: ----- Method: CCodeGenerator>>initializeCTranslationDictionary (in category 'C translation support') ----- initializeCTranslationDictionary "Initialize the dictionary mapping message names to actions for C code generation." | pairs | translationDict := Dictionary new: 200. pairs := #( #& #generateAnd:on:indent: #| #generateOr:on:indent: #abs #generateAbs:on:indent: #and: #generateSequentialAnd:on:indent: #or: #generateSequentialOr:on:indent: #not #generateNot:on:indent: #+ #generatePlus:on:indent: #- #generateMinus:on:indent: #negated #generateNegated:on:indent: #* #generateTimes:on:indent: #/ #generateDivide:on:indent: #// #generateDivide:on:indent: #\\ #generateModulo:on:indent: #<< #generateShiftLeft:on:indent: #>> #generateShiftRight:on:indent: #>>> #generateSignedShiftRight:on:indent: #min: #generateMin:on:indent: #max: #generateMax:on:indent: #between:and: #generateBetweenAnd:on:indent: #bitAnd: #generateBitAnd:on:indent: #bitOr: #generateBitOr:on:indent: #bitXor: #generateBitXor:on:indent: #bitShift: #generateBitShift:on:indent: #signedBitShift: #generateSignedBitShift:on:indent: #bitInvert32 #generateBitInvert:on:indent: #bitInvert64 #generateBitInvert:on:indent: #bitClear: #generateBitClear:on:indent: #truncateTo: #generateTruncateTo:on:indent: #rounded #generateRounded:on:indent: #byteSwap32 #generateByteSwap32:on:indent: #byteSwap64 #generateByteSwap64:on:indent: #byteSwapped32IfBigEndian: generateByteSwap32IfBigEndian:on:indent: #byteSwapped64IfBigEndian: generateByteSwap64IfBigEndian:on:indent: #< #generateLessThan:on:indent: #<= #generateLessThanOrEqual:on:indent: #= #generateEqual:on:indent: #> #generateGreaterThan:on:indent: #>= #generateGreaterThanOrEqual:on:indent: #~= #generateNotEqual:on:indent: #== #generateEqual:on:indent: #~~ #generateNotEqual:on:indent: #isNil #generateIsNil:on:indent: #notNil #generateNotNil:on:indent: #whileTrue: #generateWhileTrue:on:indent: #whileFalse: #generateWhileFalse:on:indent: #whileTrue #generateDoWhileTrue:on:indent: #whileFalse #generateDoWhileFalse:on:indent: #to:do: #generateToDo:on:indent: #to:by:do: #generateToByDo:on:indent: #repeat #generateRepeat:on:indent: #timesRepeat: #generateTimesRepeat:on:indent: #ifTrue: #generateIfTrue:on:indent: #ifFalse: #generateIfFalse:on:indent: #ifTrue:ifFalse: #generateIfTrueIfFalse:on:indent: #ifFalse:ifTrue: #generateIfFalseIfTrue:on:indent: #ifNotNil: #generateIfNotNil:on:indent: #ifNil: #generateIfNil:on:indent: #ifNotNil:ifNil: #generateIfNotNilIfNil:on:indent: #ifNil:ifNotNil: #generateIfNilIfNotNil:on:indent: #at: #generateAt:on:indent: #at:put: #generateAtPut:on:indent: #basicAt: #generateAt:on:indent: #basicAt:put: #generateAtPut:on:indent: #integerValueOf: #generateIntegerValueOf:on:indent: #integerObjectOf: #generateIntegerObjectOf:on:indent: #isIntegerObject: #generateIsIntegerObject:on:indent: #cCode: #generateInlineCCode:on:indent: #cCode:inSmalltalk: #generateInlineCCode:on:indent: #cPreprocessorDirective: #generateInlineCPreprocessorDirective:on:indent: #cppIf:ifTrue:ifFalse: #generateInlineCppIfElse:on:indent: #cppIf:ifTrue: #generateInlineCppIfElse:on:indent: #cCoerce:to: #generateCCoercion:on:indent: #cCoerceSimple:to: #generateCCoercion:on:indent: #addressOf: #generateAddressOf:on:indent: #addressOf:put: #generateAddressOf:on:indent: #asAddress:put: #generateAsAddress:on:indent: #signedIntFromLong64 #generateSignedIntFromLong64:on:indent: #signedIntFromLong #generateSignedIntFromLong:on:indent: #signedIntFromShort #generateSignedIntFromShort:on:indent: #signedIntToLong64 #generateSignedIntToLong64:on:indent: #signedIntToLong #generateSignedIntToLong:on:indent: #signedIntToShort #generateSignedIntToShort:on:indent: #preIncrement #generatePreIncrement:on:indent: #preDecrement #generatePreDecrement:on:indent: #inline: #generateInlineDirective:on:indent: #asFloat #generateAsFloat:on:indent: #asInteger #generateAsInteger:on:indent: + #asIntegerPtr #generateAsIntegerPtr:on:indent: #asUnsignedInteger #generateAsUnsignedInteger:on:indent: + #asUnsignedIntegerPtr #generateAsUnsignedIntegerPtr:on:indent: #asLong #generateAsLong:on:indent: #asUnsignedLong #generateAsUnsignedLong:on:indent: #asUnsignedLongLong #generateAsUnsignedLongLong:on:indent: #asVoidPointer #generateAsVoidPointer:on:indent: #asSymbol #generateAsSymbol:on:indent: #flag: #generateFlag:on:indent: #anyMask: #generateBitAnd:on:indent: #allMask: #generateAllMask:on:indent: #noMask: #generateNoMask:on:indent: #raisedTo: #generateRaisedTo:on:indent: #touch: #generateTouch:on:indent: #bytesPerOop #generateBytesPerOop:on:indent: #bytesPerWord #generateBytesPerWord:on:indent: #wordSize #generateBytesPerWord:on:indent: #baseHeaderSize #generateBaseHeaderSize:on:indent: #minSmallInteger #generateSmallIntegerConstant:on:indent: #maxSmallInteger #generateSmallIntegerConstant:on:indent: #sharedCodeNamed:inCase: #generateSharedCodeDirective:on:indent: #perform: #generatePerform:on:indent: #perform:with: #generatePerform:on:indent: #perform:with:with: #generatePerform:on:indent: #perform:with:with:with: #generatePerform:on:indent: #perform:with:with:with:with: #generatePerform:on:indent: #perform:with:with:with:with:with: #generatePerform:on:indent: #value #generateValue:on:indent: #value: #generateValue:on:indent: #value:value: #generateValue:on:indent: #value:value:value: #generateValue:on:indent: #value:value:value:value: #generateValue:on:indent: #deny: #generateDeny:on:indent: #shouldNotImplement #generateSmalltalkMetaError:on:indent: #shouldBeImplemented #generateSmalltalkMetaError:on:indent: #subclassResponsibility #generateSmalltalkMetaError:on:indent: ). 1 to: pairs size by: 2 do: [:i | translationDict at: (pairs at: i) put: (pairs at: i + 1)]. pairs := #( #ifTrue: #generateIfTrueAsArgument:on:indent: #ifFalse: #generateIfFalseAsArgument:on:indent: #ifTrue:ifFalse: #generateIfTrueIfFalseAsArgument:on:indent: #ifFalse:ifTrue: #generateIfFalseIfTrueAsArgument:on:indent: #ifNotNil: #generateIfNotNilAsArgument:on:indent: #ifNil: #generateIfNilAsArgument:on:indent: #ifNotNil:ifNil: #generateIfNotNilIfNilAsArgument:on:indent: #ifNil:ifNotNil: #generateIfNilIfNotNilAsArgument:on:indent: #cCode: #generateInlineCCodeAsArgument:on:indent: #cCode:inSmalltalk: #generateInlineCCodeAsArgument:on:indent: #cppIf:ifTrue:ifFalse: #generateInlineCppIfElseAsArgument:on:indent: #cppIf:ifTrue: #generateInlineCppIfElseAsArgument:on:indent: #value #generateValueAsArgument:on:indent: #value: #generateValueAsArgument:on:indent: #value:value: #generateValueAsArgument:on:indent: ). asArgumentTranslationDict := Dictionary new: 8. 1 to: pairs size by: 2 do: [:i | asArgumentTranslationDict at: (pairs at: i) put: (pairs at: i + 1)]. ! Item was changed: ----- Method: CCodeGenerator>>isIntegralCType: (in category 'inlining') ----- isIntegralCType: aCType "<String>" + ^(#('sqLong' 'usqLong' 'sqInt' 'usqInt' 'sqIntptr_t' 'usqIntptr_t' - ^(#('sqLong' 'usqLong' 'sqInt' 'usqInt' 'long' 'int' 'short' 'char' 'signed char' 'size_t' 'pid_t') includes: aCType asString) or: [(aCType beginsWith: 'unsigned') "Accept e.g. 'unsigned long' and also 'unsigned : 8'" and: [(aCType includesAnyOf: '[*]') not]]! Item was changed: ----- Method: CCodeGenerator>>returnTypeForSend:in:ifNil: (in category 'type inference') ----- returnTypeForSend: sendNode in: aTMethod ifNil: typeIfNil "Answer the return type for a send. Unbound sends default to typeIfNil. Methods with types as yet unknown have a type determined either by the kernelReturnTypes or the table below, or, if they are in neither set, then nil. The inferred type should match as closely as possible the C type of generated expessions so that inlining would not change the expression. If there is a method for sel but its return type is as yet unknown it mustn't be defaulted, since on a subsequent pass its type may be computable." | sel methodOrNil | methodOrNil := self anyMethodNamed: (sel := sendNode selector). (methodOrNil notNil and: [methodOrNil returnType notNil]) ifTrue: [^self baseTypeForType: methodOrNil returnType]. ^kernelReturnTypes at: sel ifAbsent: [sel caseOf: { [#integerValueOf:] -> [#sqInt]. [#isIntegerObject:] -> [#int]. [#negated] -> [self promoteArithmeticTypes: (self typeFor: sendNode receiver in: aTMethod) and: #int]. [#+] -> [self typeForArithmetic: sendNode in: aTMethod]. [#-] -> [self typeForArithmetic: sendNode in: aTMethod]. [#*] -> [self typeForArithmetic: sendNode in: aTMethod]. [#/] -> [self typeForArithmetic: sendNode in: aTMethod]. [#//] -> [self typeForArithmetic: sendNode in: aTMethod]. [#\\] -> [self typeForArithmetic: sendNode in: aTMethod]. [#rem:] -> [self typeForArithmetic: sendNode in: aTMethod]. [#quo:] -> [self typeForArithmetic: sendNode in: aTMethod]. "C99 Sec Bitwise shift operators ... 3 Sematics ... The integer promotions are performed on each of the operands. The type of the result is that of the promoted left operand..." [#>>] -> [self typeFor: sendNode receiver in: aTMethod]. [#<<] -> [self typeFor: sendNode receiver in: aTMethod]. [#addressOf:] -> [(self typeFor: sendNode receiver in: aTMethod) ifNil: [#sqInt] ifNotNil: [:type| type, (type last isLetter ifTrue: [' *'] ifFalse: ['*'])]]. [#at:] -> [self typeForDereference: sendNode in: aTMethod]. [#bitAnd:] -> [self typeForArithmetic: sendNode in: aTMethod]. [#bitOr:] -> [self typeForArithmetic: sendNode in: aTMethod]. [#bitXor:] -> [self typeForArithmetic: sendNode in: aTMethod]. [#bitClear:] -> [self typeForArithmetic: sendNode in: aTMethod]. [#bitInvert32] -> [#'unsigned int']. [#bitInvert64] -> [self promoteArithmeticTypes: (self typeFor: sendNode receiver in: aTMethod) and: #int]. [#byteSwap32] -> [#'unsigned int']. [#byteSwap64] -> [#'unsigned long long']. [#byteSwapped32IfBigEndian:] -> [#'unsigned int']. [#byteSwapped64IfBigEndian:] -> [#'unsigned long long']. [#=] -> [#int]. [#~=] -> [#int]. [#==] -> [#int]. [#~~] -> [#int]. [#<] -> [#int]. [#<=] -> [#int]. [#>] -> [#int]. [#>=] -> [#int]. [#between:and:] -> [#int]. [#anyMask:] -> [#int]. [#allMask:] -> [#int]. [#noMask:] -> [#int]. [#isNil] -> [#int]. [#notNil] -> [#int]. [#&] -> [#int]. [#|] -> [#int]. [#not] -> [#int]. [#asFloat] -> [#double]. [#atan] -> [#double]. [#exp] -> [#double]. [#log] -> [#double]. [#sin] -> [#double]. [#sqrt] -> [#double]. [#asLong] -> [#long]. [#asInteger] -> [#sqInt]. + [#asIntegerPtr] -> [#'sqIntptr_t']. [#asUnsignedInteger] -> [#usqInt]. + [#asUnsignedIntegerPtr]-> [#'usqIntptr_t']. [#asUnsignedLong] -> [#'unsigned long']. [#asUnsignedLongLong] -> [#'unsigned long long']. [#asVoidPointer] -> [#'void *']. [#signedIntToLong] -> [#usqInt]. "c.f. generateSignedIntToLong:on:indent:" [#signedIntToShort] -> [#usqInt]. "c.f. generateSignedIntToShort:on:indent:" [#cCoerce:to:] -> [sendNode args last value]. [#cCoerceSimple:to:] -> [sendNode args last value]. [#sizeof:] -> [#'unsigned long']. "Technically it's a size_t but it matches unsigned long on target architectures so far..." [#ifTrue:ifFalse:] -> [self typeForConditional: sendNode in: aTMethod]. [#ifFalse:ifTrue:] -> [self typeForConditional: sendNode in: aTMethod]. [#ifTrue:] -> [self typeForConditional: sendNode in: aTMethod]. [#ifFalse:] -> [self typeForConditional: sendNode in: aTMethod]. [#and:] -> [#sqInt]. [#or:] -> [#sqInt] } otherwise: "If there /is/ a method for sel but its return type is as yet unknown it /mustn't/ be defaulted, since on a subsequent pass its type may be computable. Only default unbound selectors." [methodOrNil ifNotNil: [nil] ifNil: [typeIfNil]]]! Item was changed: ----- Method: CCodeGenerator>>signedTypeForIntegralType: (in category 'type inference') ----- signedTypeForIntegralType: aCTypeString (aCTypeString beginsWith: 'unsigned ') ifTrue: [^aCTypeString allButFirst: 8]. (aCTypeString beginsWith: 'usq') ifTrue: [^aCTypeString allButFirst]. + aCTypeString = 'size_t' ifTrue: [^#usqIntptr_t]. + self error: 'unknown type'. ^#long! Item was changed: ----- Method: CCodeGenerator>>sizeOfIntegralCType: (in category 'inlining') ----- sizeOfIntegralCType: anIntegralCType "<String>" "N.B. Only works for values for which isIntegralCType: answers true." | prunedCType index | (anIntegralCType beginsWith: 'register ') ifTrue: [^self sizeOfIntegralCType: (anIntegralCType allButFirst: 9)]. prunedCType := (anIntegralCType beginsWith: 'unsigned ') ifTrue: [(anIntegralCType allButFirst: 9) withBlanksTrimmed] ifFalse: [(anIntegralCType beginsWith: 'signed ') ifTrue: [(anIntegralCType allButFirst: 7) withBlanksTrimmed] ifFalse: [anIntegralCType]]. + ^prunedCType asString caseOf: { ['sqLong'] -> [8]. ['usqLong'] -> [8]. ['long long'] -> [8]. + ['sqInt'] -> [BytesPerOop]. + ['usqInt'] -> [BytesPerOop]. + ['sqIntptr_t'] -> [BytesPerWord]. + ['usqIntptr_t'] -> [BytesPerWord]. - ['sqInt'] -> [BytesPerWord]. - ['usqInt'] -> [BytesPerWord]. ['int'] -> [4]. ['short'] -> [2]. ['short int'] -> [2]. ['char'] -> [1]. + ['long'] -> [BytesPerWord]. "It's ambiguous on LLP64 and we'll later remove it" + ['size_t'] -> [BytesPerWord]. - ['long'] -> [BytesPerWord]. - ['size_t'] -> [BytesPerWord]. ['pid_t'] -> [BytesPerWord]. } otherwise: [((anIntegralCType beginsWith: 'unsigned') "e.g. 'unsigned : 8'" and: [(anIntegralCType includesAnyOf: '[*]') not and: [(index := anIntegralCType indexOf: $:) > 0]]) ifTrue: [(Integer readFrom: (anIntegralCType copyFrom: index + 1 to: anIntegralCType size) withBlanksTrimmed readStream) + 7 // 8] ifFalse: [self error: 'unrecognized integral type']]! Item was added: + ----- Method: CogAbstractInstruction>>asIntegerPtr (in category 'coercion') ----- + asIntegerPtr + <doNotGenerate> + ^self! Item was added: + ----- Method: CogAbstractInstruction>>asUnsignedIntegerPtr (in category 'coercion') ----- + asUnsignedIntegerPtr + <doNotGenerate> + ^self! Item was changed: ----- Method: CogClass>>cCoerceSimple:to: (in category 'translation support') ----- cCoerceSimple: value to: cTypeString <doNotGenerate> "Type coercion for translation and simulation. For simulation answer a suitable surrogate for the struct types" ^cTypeString caseOf: { [#'unsigned long'] -> [value]. [#'unsigned int'] -> [value]. [#sqInt] -> [value]. + [#'sqIntptr_t'] -> [value]. + [#'usqIntptr_t'] -> [value]. [#usqInt] -> [value]. [#sqLong] -> [value]. [#usqLong] -> [value]. [#'AbstractInstruction *'] -> [value]. [#'BytecodeFixup *'] -> [value]. [#'CogMethod *'] -> [value]. [#'char *'] -> [value]. [#'sqInt *'] -> [value]. [#'void *'] -> [value]. [#void] -> [value]. [#'void (*)()'] -> [value]. [#'void (*)(void)'] -> [value]. [#'unsigned long (*)(void)'] -> [value]. [#'void (*)(unsigned long,unsigned long)'] -> [value] }! Item was added: + ----- Method: CogMethodSurrogate>>asIntegerPtr (in category 'accessing') ----- + asIntegerPtr + "Answer the surrogate's adress. This is equivalent to a C cast to usqIntptr_t, + which is precisely what Slang generates for asIntegerPtr" + ^address! Item was added: + ----- Method: CogMethodSurrogate>>asUnsignedIntegerPtr (in category 'accessing') ----- + asUnsignedIntegerPtr + "Answer the surrogate's adress. This is equivalent to a C cast to usqIntptr_t, + which is precisely what Slang generates for asUnsignedIntegerPtr" + ^address! Item was added: + ----- Method: CogSSBytecodeFixup>>asIntegerPtr (in category 'simulation support') ----- + asIntegerPtr + <doNotGenerate> + ^self! Item was added: + ----- Method: CogSSBytecodeFixup>>asUnsignedIntegerPtr (in category 'simulation support') ----- + asUnsignedIntegerPtr + <doNotGenerate> + ^self! Item was added: + ----- Method: CogStackPageSurrogate>>asIntegerPtr (in category 'accessing') ----- + asIntegerPtr + ^address! Item was added: + ----- Method: CogStackPageSurrogate>>asUnsignedIntegerPtr (in category 'accessing') ----- + asUnsignedIntegerPtr + ^address! Item was added: + ----- Method: Integer>>asIntegerPtr (in category '*VMMaker-interpreter simulator') ----- + asIntegerPtr + ^self! Item was added: + ----- Method: Integer>>asUnsignedIntegerPtr (in category '*VMMaker-interpreter simulator') ----- + asUnsignedIntegerPtr + "Since the simulator deals with positive integers most of the time we assert that the receiver is greater than zero. + But one major exception is stack pointers in the StackInterpreterSimulator, which are negative. So don't fail + if the sender is a StackInterpreter and the receiver could be a stack pointer." + self >= 0 ifFalse: + [self assert: ((thisContext sender methodClass includesBehavior: StackInterpreter) + and: [thisContext sender receiver stackPages couldBeFramePointer: self])]. + ^self! Item was changed: ----- Method: InterpreterPlugin>>sizeof: (in category 'simulation support') ----- sizeof: objectSymbolOrClass <doNotGenerate> objectSymbolOrClass isInteger ifTrue: [^interpreterProxy wordSize]. objectSymbolOrClass isSymbol ifTrue: ["In the simulator file handles are just integer indices into openFiles and so need only be BytesPerWord big. But in the actual VM they are at least 5 words long." objectSymbolOrClass == #SQFile ifTrue: [^interpreterProxy wordSize * 5]. "SQSocket is typedef struct { int sessionID; int socketType; void *privateSocketPtr; } SQSocket" objectSymbolOrClass == #SQSocket ifTrue: [^8 + interpreterProxy wordSize]. "We assume the file offset type is always 64-bits." objectSymbolOrClass == #squeakFileOffsetType ifTrue: [^8]. (objectSymbolOrClass last == $* or: [#long == objectSymbolOrClass + or: [#'unsigned long' == objectSymbolOrClass + or: [#'sqIntptr_t' == objectSymbolOrClass + or: [#'usqIntptr_t' == objectSymbolOrClass + or: [#'size_t' == objectSymbolOrClass]]]]]) ifTrue: - or: [#'unsigned long' == objectSymbolOrClass]]) ifTrue: [^interpreterProxy wordSize]. (#(usqInt sqInt) includes: objectSymbolOrClass) ifTrue: [^interpreterProxy bytesPerOop]]. ^super sizeof: objectSymbolOrClass! Item was changed: ----- Method: SistaCogit>>picDataFor:Annotation:Mcpc:Bcpc:Method: (in category 'method introspection') ----- picDataFor: descriptor Annotation: isBackwardBranchAndAnnotation Mcpc: mcpc Bcpc: bcpc Method: cogMethodArg <var: #descriptor type: #'BytecodeDescriptor *'> <var: #mcpc type: #'char *'> <var: #cogMethodArg type: #'void *'> | annotation entryPoint tuple counter | + <var: #counter type: #usqInt> - <var: #counter type: #'unsigned long'> descriptor ifNil: [^0]. descriptor isBranch ifTrue: ["it's a branch; conditional?" (descriptor isBranchTrue or: [descriptor isBranchFalse]) ifTrue: [counter := (self cCoerce: ((self cCoerceSimple: cogMethodArg to: #'CogMethod *') counters) + to: #'usqInt *') - to: #'unsigned long *') at: counterIndex. tuple := self picDataForCounter: counter at: bcpc + 1. tuple = 0 ifTrue: [^PrimErrNoMemory]. objectMemory storePointer: introspectionDataIndex ofObject: introspectionData withValue: tuple. introspectionDataIndex := introspectionDataIndex + 1. counterIndex := counterIndex + 1]. ^0]. annotation := isBackwardBranchAndAnnotation >> 1. ((self isPureSendAnnotation: annotation) and: [entryPoint := backEnd callTargetFromReturnAddress: mcpc asUnsignedInteger. entryPoint > methodZoneBase]) ifFalse: "send is not linked, or is not a send" [^0]. self targetMethodAndSendTableFor: entryPoint "It's a linked send; find which kind." annotation: annotation into: [:targetMethod :sendTable| | methodClassIfSuper association | methodClassIfSuper := nil. sendTable = superSendTrampolines ifTrue: [methodClassIfSuper := coInterpreter methodClassOf: (self cCoerceSimple: cogMethodArg to: #'CogMethod *') methodObject]. sendTable = directedSuperSendTrampolines ifTrue: [association := backEnd literalBeforeInlineCacheTagAt: mcpc asUnsignedInteger. methodClassIfSuper := objectRepresentation valueOfAssociation: association]. tuple := self picDataForSendTo: targetMethod methodClassIfSuper: methodClassIfSuper at: mcpc bcpc: bcpc + 1]. tuple = 0 ifTrue: [^PrimErrNoMemory]. objectMemory storePointer: introspectionDataIndex ofObject: introspectionData withValue: tuple. introspectionDataIndex := introspectionDataIndex + 1. ^0! Item was changed: ----- Method: SistaCogit>>picDataForCounter:at: (in category 'method introspection') ----- picDataForCounter: counter at: bcpc | executedCount tuple untakenCount | + <var: #counter type: #usqInt> - <var: #counter type: #'unsigned long'> tuple := objectMemory eeInstantiateClassIndex: ClassArrayCompactIndex format: objectMemory arrayFormat numSlots: 3. tuple = 0 ifTrue: [^0]. self assert: CounterBytes = 4. executedCount := initialCounterValue - (counter >> 16). untakenCount := initialCounterValue - (counter bitAnd: 16rFFFF). objectMemory storePointerUnchecked: 0 ofObject: tuple withValue: (objectMemory integerObjectOf: bcpc); storePointerUnchecked: 1 ofObject: tuple withValue: (objectMemory integerObjectOf: executedCount); storePointerUnchecked: 2 ofObject: tuple withValue: (objectMemory integerObjectOf: untakenCount). ^tuple! Item was changed: ----- Method: Spur32BitMemoryManager>>integerObjectOfCharacterObject: (in category 'immediates') ----- integerObjectOfCharacterObject: oop "Immediate characters are unsigned" + ^(self cCoerceSimple: oop to: #usqInt) >> 1! - ^(self cCoerceSimple: oop to: #'unsigned long') >> 1! Item was changed: ----- Method: SpurMemoryManager class>>declareCVarsIn: (in category 'translation') ----- declareCVarsIn: aCCodeGenerator self declareCAsOop: #( memory freeStart scavengeThreshold newSpaceStart newSpaceLimit pastSpaceStart lowSpaceThreshold freeOldSpaceStart oldSpaceStart endOfMemory firstFreeChunk lastFreeChunk) in: aCCodeGenerator. self declareCAsUSqLong: (self allInstVarNames select: [:ivn| ivn endsWith: 'Usecs']) in: aCCodeGenerator. aCCodeGenerator var: #freeListsMask type: #usqInt; var: #freeLists type: #'sqInt *'; var: #objStackInvalidBecause type: #'char *'; var: #unscannedEphemerons type: #SpurContiguousObjStack; var: #heapGrowthToSizeGCRatio type: #float; var: #heapSizeAtPreviousGC type: #usqInt; var: #totalFreeOldSpace type: #usqInt; + var: #maxOldSpaceSize type: #usqInt. - var: #maxOldSpaceSize type: #'unsigned long'. aCCodeGenerator var: #remapBuffer declareC: 'sqInt remapBuffer[RemapBufferSize + 1 /* ', (RemapBufferSize + 1) printString, ' */]'. aCCodeGenerator var: #extraRoots declareC: 'sqInt *extraRoots[ExtraRootsSize + 1 /* ', (ExtraRootsSize + 1) printString, ' */]'! Item was changed: ----- Method: SpurMemoryManager>>setMaxOldSpaceSize: (in category 'accessing') ----- setMaxOldSpaceSize: limit + <var: #limit type: #usqInt> - <var: #limit type: #'unsigned long'> maxOldSpaceSize := limit. ^0! Item was changed: ----- Method: ThreadedFFIPlugin>>primitiveFFIIntegerAt (in category 'primitives') ----- primitiveFFIIntegerAt "Answer a (signed or unsigned) n byte integer from the given byte offset in the receiver, using the platform's endianness." | isSigned byteSize byteOffset rcvr addr value mask valueOop | <var: 'value' type: #usqLong> <var: 'mask' type: #usqLong> <export: true> <inline: false> isSigned := interpreterProxy booleanValueOf: (interpreterProxy stackValue: 0). byteSize := interpreterProxy stackIntegerValue: 1. byteOffset := interpreterProxy stackIntegerValue: 2. rcvr := interpreterProxy stackObjectValue: 3. interpreterProxy failed ifTrue:[^0]. (byteOffset > 0 and: [(byteSize between: 1 and: 8) and: [(byteSize bitAnd: byteSize - 1) = 0 "a.k.a. isPowerOfTwo"]]) ifFalse: [^interpreterProxy primitiveFail]. addr := self ffiAddressOf: rcvr startingAt: byteOffset size: byteSize. interpreterProxy failed ifTrue:[^0]. byteSize <= 2 ifTrue: [byteSize = 1 ifTrue: [value := self cCoerceSimple: (interpreterProxy byteAt: addr) to: #'unsigned char'] ifFalse: [value := self cCoerceSimple: (interpreterProxy shortAt: addr) to: #'unsigned short']] ifFalse: [byteSize = 4 ifTrue: [value := self cCoerceSimple: (interpreterProxy long32At: addr) to: #'unsigned int'] ifFalse: [value := interpreterProxy long64At: addr]]. byteSize < BytesPerWord ifTrue: [isSigned ifTrue: "sign extend value" + [mask := 1 asUnsignedLongLong << (byteSize * 8 - 1). - [mask := 1 << (byteSize * 8 - 1). value := (value bitAnd: mask-1) - (value bitAnd: mask)]. "note: byte/short (&long if BytesPerWord=8) never exceed SmallInteger range" valueOop := interpreterProxy integerObjectOf: value] ifFalse: "general 64 bit integer; note these never fail" [isSigned ifTrue: [byteSize < 8 ifTrue: "sign extend value" + [mask := 1 asUnsignedLongLong << (byteSize * 8 - 1). - [mask := 1 << (byteSize * 8 - 1). value := (value bitAnd: mask-1) - (value bitAnd: mask)]. valueOop := interpreterProxy signed64BitIntegerFor: value] ifFalse:[valueOop := interpreterProxy positive64BitIntegerFor: value]]. ^interpreterProxy pop: 4 thenPush: valueOop! Item was added: + ----- Method: UndefinedObject>>asIntegerPtr (in category '*VMMaker-interpreter simulator') ----- + asIntegerPtr + ^self! Item was added: + ----- Method: UndefinedObject>>asUnsignedIntegerPtr (in category '*VMMaker-interpreter simulator') ----- + asUnsignedIntegerPtr + ^self! Item was changed: ----- Method: VMClass>>sizeof: (in category 'translation support') ----- sizeof: objectSymbolOrClass <doNotGenerate> | index | objectSymbolOrClass isInteger ifTrue: [^self class objectMemoryClass wordSize]. + (#(usqInt sqInt) includes: objectSymbolOrClass) ifTrue: [^self class objectMemoryClass bytesPerOop]. objectSymbolOrClass isSymbol ifTrue: [(objectSymbolOrClass last == $* + or: [#(#long #'unsigned long' #'sqIntptr_t' #'usqIntptr_t' #'size_t') includes: objectSymbolOrClass]) ifTrue: - or: [#long == objectSymbolOrClass - or: [#'unsigned long' == objectSymbolOrClass]]) ifTrue: [^self class objectMemoryClass wordSize]. index := #( #sqLong #usqLong #double #int #'unsigned int' #float #short #'unsigned short' #char #'unsigned char' #'signed char') indexOf: objectSymbolOrClass ifAbsent: + [self error: 'unrecognized C type name']. - [(#(usqInt sqInt) includes: objectSymbolOrClass) ifTrue: [^self class objectMemoryClass bytesPerOop]. - self error: 'unrecognized C type name']. ^#(8 8 8 4 4 4 2 2 1 1 1) at: index]. ^(objectSymbolOrClass isBehavior ifTrue: [objectSymbolOrClass] ifFalse: [objectSymbolOrClass class]) alignedByteSizeOf: objectSymbolOrClass forClient: self!

1 0

[OpenSmalltalk/opensmalltalk-vm] 34930f: Update Mac HowToBuilds with a solution for signing...
by GitHub 04 Nov '16

04 Nov '16

Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: 34930ff36ab35309d8833418ab718bc7e5e1abed https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/34930ff36ab35309d8… Author: Eliot Miranda <eliot.miranda(a)gmail.com> Date: 2016-11-04 (Fri, 04 Nov 2016) Changed paths: M build.macos32x86/HowToBuild M build.macos64x64/HowToBuild Log Message: ----------- Update Mac HowToBuilds with a solution for signing when logging in remotely.

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Vm-dev November 2016