Packages June 2020

packages@lists.squeakfoundation.org

1 participants
151 discussions

The Trunk: ShoutCore-mt.79.mcz
by commits＠source.squeak.org 14 Jun '20

14 Jun '20

Marcel Taeumel uploaded a new version of ShoutCore to project The Trunk: http://source.squeak.org/trunk/ShoutCore-mt.79.mcz ==================== Summary ==================== Name: ShoutCore-mt.79 Author: mt Time: 13 June 2020, 10:34:17.329351 am UUID: 20850ea4-bd6b-9642-9333-ed6b4ce1e81d Ancestors: ShoutCore-mt.78 Tweaks performance of method lookup for pragma parsing. See http://forum.world.st/The-Inbox-ShoutCore-mt-78-mcz-td5118289.html =============== Diff against ShoutCore-mt.77 =============== Item was removed: - ----- Method: SHParserST80>>isTokenExternalFunctionCallingConvention (in category 'token testing') ----- - isTokenExternalFunctionCallingConvention - - currentToken ifNil: [ ^false ]. - ^(Smalltalk classNamed: #ExternalFunction) - ifNil: [ false ] - ifNotNil: [ :descriptorClass | - (descriptorClass callingConventionFor: currentToken) notNil ]! Item was removed: - ----- Method: SHParserST80>>parseExternalCall (in category 'parse') ----- - parseExternalCall - [self scanNext. - ((Smalltalk at: #ExternalFunction) callingConventionModifierFor: currentToken) notNil] - whileTrue. - self failUnless: currentToken notNil. - self scanPast: #externalCallType. - currentToken = '*' - ifTrue: [self scanPast: #externalCallTypePointerIndicator]. - currentTokenFirst isDigit - ifTrue: [self scanPast: #integer] - ifFalse: [ - self failUnless: currentTokenFirst == $'. - self parseString]. - self failUnless: currentTokenFirst == $(. - self scanPast: #leftParenthesis. - [currentTokenFirst ~= $)] - whileTrue: [ - self failUnless: currentToken notNil. - self scanPast: #externalCallType. - currentToken = '*' - ifTrue: [self scanPast: #externalCallTypePointerIndicator]]. - self scanPast: #rightParenthesis. - currentToken = 'module:' - ifTrue: [ - self scanPast: #module. - self parseStringOrSymbol ]. - currentToken = 'error:' ifTrue: [ - self scanPast: #primitive. "there's no rangeType for error" - self currentTokenType == #name - ifTrue: [ self parseTemporary: #patternTempVar ] - ifFalse: [ self parseStringOrSymbol ] ]. - self failUnless: currentToken = '>'. - self scanPast: #primitiveOrExternalCallEnd! Item was changed: + ----- Method: SHParserST80>>parsePragmaBinary (in category 'parse pragma') ----- - ----- Method: SHParserST80>>parsePragmaBinary (in category 'parse') ----- parsePragmaBinary self scanPast: #pragmaBinary. self currentTokenType == #name ifTrue:[self scanPast: (self resolvePragmaArgument: currentToken)] ifFalse:[ self parseLiteral: false]. self failUnless: currentToken = '>'. self scanPast: #primitiveOrExternalCallEnd! Item was changed: + ----- Method: SHParserST80>>parsePragmaKeyword (in category 'parse pragma') ----- - ----- Method: SHParserST80>>parsePragmaKeyword (in category 'parse') ----- parsePragmaKeyword [self currentTokenType == #keyword] whileTrue:[ self scanPast: #pragmaKeyword. self currentTokenType == #name ifTrue:[self scanPast: (self resolvePragmaArgument: currentToken)] ifFalse:[ self parseLiteral: false]]. self failUnless: currentToken = '>'. self scanPast: #primitiveOrExternalCallEnd! Item was changed: + ----- Method: SHParserST80>>parsePragmaSequence (in category 'parse pragma') ----- - ----- Method: SHParserST80>>parsePragmaSequence (in category 'parse') ----- parsePragmaSequence + [currentToken = '<' ] + whileTrue: [ - whileTrue:[ self scanPast: #primitiveOrExternalCallStart. + self parsePragmaStatement].! - currentToken = 'primitive:' - ifTrue: [ - self addRangeType: #primitive. - self parsePrimitive] - ifFalse:[ - self isTokenExternalFunctionCallingConvention - ifTrue: [ - self addRangeType: #externalFunctionCallingConvention. - self parseExternalCall] - ifFalse:[ - self currentTokenType - caseOf: { - [ #name ] -> [ - self scanPast: #pragmaUnary. - self failUnless: currentToken = '>'. - self scanPast: #primitiveOrExternalCallEnd ]. - [ #binary ] -> [ self parsePragmaBinary ]. - [ #keyword ] -> [ self parsePragmaKeyword ] } - otherwise: [ self fail ": 'Invalid External Function Calling convention'" ] ] ] ]! Item was added: + ----- Method: SHParserST80>>parsePragmaStatement (in category 'parse pragma') ----- + parsePragmaStatement + + | parserSelector | + (currentToken last == $: + and: [(parserSelector := Symbol lookup: currentToken allButLast) notNil]) + ifFalse: ["Quick exit to not break one-word pragmas such as <primitive> and <foobar>; also avoid interning new symbols for made-up pragmas such as for <my: 1 new: 2 pragma: 3> not interning #my." + ^ self parsePragmaStatementKeywords]. + + self class methodDict + at: parserSelector + ifPresent: [:parserMethod | + (parserMethod pragmas + anySatisfy: [:pragma | pragma keyword == #pragmaParser]) + ifTrue: [^ self executeMethod: parserMethod]]. + + ^ self parsePragmaStatementKeywords! Item was added: + ----- Method: SHParserST80>>parsePragmaStatementKeywords (in category 'parse pragma') ----- + parsePragmaStatementKeywords + + self currentTokenType + caseOf: { + [ #name ] -> [ + self scanPast: #pragmaUnary. + self failUnless: currentToken = '>'. + self scanPast: #primitiveOrExternalCallEnd ]. + [ #binary ] -> [ self parsePragmaBinary ]. + [ #keyword ] -> [ self parsePragmaKeyword ] } + otherwise: [ self fail ": 'Invalid External Function Calling convention'" ]. ! Item was removed: - ----- Method: SHParserST80>>parsePrimitive (in category 'parse') ----- - parsePrimitive - - self scanNext. - currentTokenFirst isDigit - ifTrue: [ self scanPast: #integer ] - ifFalse: [ - self parseStringOrSymbol. - currentToken = 'module:' ifTrue: [ - self scanPast: #module. - self parseStringOrSymbol ] ]. - currentToken = 'error:' ifTrue: [ - self scanPast: #primitive. "there's no rangeType for error" - self currentTokenType == #name - ifTrue: [ self parseTemporary: #patternTempVar ] - ifFalse: [ self parseStringOrSymbol ] ]. - self failUnless: currentToken = '>'. - self scanPast: #primitiveOrExternalCallEnd! Item was added: + ----- Method: SHParserST80>>primitive (in category 'parse pragma') ----- + primitive + "Parse keywords and literals of primitive pragmas differently to emit different range tokens for different UI styling. This hook exists so that packages do not break primitive-pragma parsing by accident. Instead, this method needs to be replaced intentionally." + <pragmaParser> + + self addRangeType: #primitive. + + self scanNext. + currentTokenFirst isDigit + ifTrue: [ self scanPast: #integer ] + ifFalse: [ + self parseStringOrSymbol. + currentToken = 'module:' ifTrue: [ + self scanPast: #module. + self parseStringOrSymbol ] ]. + currentToken = 'error:' ifTrue: [ + self scanPast: #primitive. "there's no rangeType for error" + self currentTokenType == #name + ifTrue: [ self parseTemporary: #patternTempVar ] + ifFalse: [ self parseStringOrSymbol ] ]. + self failUnless: currentToken = '>'. + self scanPast: #primitiveOrExternalCallEnd!

1 0

FFI: FFI-Kernel-mt.106.mcz
by commits＠source.squeak.org 13 Jun '20

13 Jun '20

Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.106.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.106 Author: mt Time: 13 June 2020, 6:40:12.388471 pm UUID: c2a1a9c3-1ef1-5843-b2ae-28b3d19ad833 Ancestors: FFI-Kernel-mt.105 Adds an interface to interpret ExternalData. The behavior compares with the code generated for struct-field accessors, i.e., #readFieldAt: <=> #handle:at: and #writeFieldAt:with: <=> #handle:at:put:. In contrast to the interface in ByteArray/ExternalAddress, offer guards to avoid misinterpretation. For example, compare ExternalData >> #signedLongLongAt: with ByteArray >> #signedLongLongAt:. Note that you can always force a different interpretation through ExternalData >> #asType:. Also clarify the role of ExternalData by hard-coding #byteAlignment, #byteSize, #compiledSpec, etc. Also offer a simple way to convert external structures (and unions) to external data and back. Note the difference between #asExternalStructure and #getExternalStructure. I hope the name is okay. =============== Diff against FFI-Kernel-mt.105 =============== Item was added: + ----- Method: ExternalData class>>byteAlignment (in category 'external type') ----- + byteAlignment + + ^ self externalType byteAlignment! Item was added: + ----- Method: ExternalData class>>byteSize (in category 'external type') ----- + byteSize + + ^ self externalType byteSize! Item was added: + ----- Method: ExternalData class>>compiledSpec (in category 'external type') ----- + compiledSpec + + ^ self externalType compiledSpec! Item was added: + ----- Method: ExternalData class>>setCompiledSpec:byteAlignment: (in category 'external type') ----- + setCompiledSpec: spec byteAlignment: alignment + + self shouldNotImplement.! Item was added: + ----- Method: ExternalData>>asExternalData (in category 'converting') ----- + asExternalData + + ^ self! Item was added: + ----- Method: ExternalData>>asExternalStructure (in category 'converting') ----- + asExternalStructure + + self + assert: [type referentClass includesBehavior: ExternalStructure] + description: 'Wrong type'. + + ^ type referentClass fromHandle: handle! Item was added: + ----- Method: ExternalData>>asExternalUnion (in category 'converting') ----- + asExternalUnion + + self + assert: [type referentClass includesBehavior: ExternalUnion] + description: 'Wrong type'. + + ^ type referentClass fromHandle: handle! Item was added: + ----- Method: ExternalData>>asType: (in category 'converting') ----- + asType: anExternalType + + ^ ExternalData fromHandle: handle type: anExternalType! Item was added: + ----- Method: ExternalData>>assert:at: (in category 'accessing') ----- + assert: expectedType at: index + + self + assert: [type = expectedType asPointerType] + description: 'Wrong type'. + + ^ self at: index! Item was added: + ----- Method: ExternalData>>assert:at:put: (in category 'accessing') ----- + assert: expectedType at: index put: value + + self + assert: [type = expectedType] + description: 'Wrong type'. + + ^ self at: index put: value! Item was added: + ----- Method: ExternalData>>at: (in category 'accessing') ----- + at: index + + self + flag: #externalDataArray; + assert: [index = 1 or: [type isAtomic]] + description: 'Should not read non-atomic pointer as array'. + + ^ type asNonPointerType + handle: handle + at: ((index-1) * type asNonPointerType byteSize) + 1! Item was added: + ----- Method: ExternalData>>at:put: (in category 'accessing') ----- + at: index put: value + + self + flag: #externalDataArray; + assert: [index = 1 or: [type isAtomic]] + description: 'Should not read non-atomic pointer as array'. + + ^ type asNonPointerType + handle: handle + at: ((index-1) * type asNonPointerType byteSize) + 1 + put: value! Item was added: + ----- Method: ExternalData>>booleanAt: (in category 'accessing - atomic values') ----- + booleanAt: index + + ^ self + assert: ExternalType bool + at: index! Item was added: + ----- Method: ExternalData>>booleanAt:put: (in category 'accessing - atomic values') ----- + booleanAt: index put: value + + ^ self + assert: ExternalType bool + at: index + put: value! Item was added: + ----- Method: ExternalData>>doubleAt: (in category 'accessing - atomic values') ----- + doubleAt: index + + ^ self + assert: ExternalType double + at: index! Item was added: + ----- Method: ExternalData>>doubleAt:put: (in category 'accessing - atomic values') ----- + doubleAt: index put: value + + ^ self + assert: ExternalType double + at: index + put: value! Item was changed: + ----- Method: ExternalData>>externalType (in category 'accessing') ----- - ----- Method: ExternalData>>externalType (in category 'converting') ----- externalType ^ type! Item was added: + ----- Method: ExternalData>>floatAt: (in category 'accessing - atomic values') ----- + floatAt: index + + ^ self + assert: ExternalType float + at: index! Item was added: + ----- Method: ExternalData>>floatAt:put: (in category 'accessing - atomic values') ----- + floatAt: index put: value + + ^ self + assert: ExternalType float + at: index + put: value! Item was changed: ----- Method: ExternalData>>fromCString (in category 'converting') ----- fromCString "Assume that the receiver represents a C string and convert it to a Smalltalk string. hg 2/25/2000 14:18" | stream index char | + self + assert: [self externalType = ExternalType string] + description: 'Wrong type'. + - type isPointerType ifFalse: [self error: 'External object is not a pointer type.']. stream := WriteStream on: String new. index := 1. + [(char := self at: index) = 0 asCharacter] whileFalse: [ - [(char := handle unsignedCharAt: index) = 0 asCharacter] whileFalse: [ stream nextPut: char. index := index + 1]. ^stream contents! Item was added: + ----- Method: ExternalData>>getExternalStructure (in category 'accessing - external structures') ----- + getExternalStructure + "Reads an external structure from this external data. If the receiver's handle is an external address, the structure's fields will be copied into object memory. Use #asExternalStructure if you want to avoid this copy." + + self + assert: [type referentClass includesBehavior: ExternalStructure] + description: 'Wrong type'. + + ^ self at: 1! Item was added: + ----- Method: ExternalData>>getExternalUnion (in category 'accessing - external structures') ----- + getExternalUnion + "Reads an external union from this external data. If the receiver's handle is an external address, the union's fields will be copied into object memory. Use #asExternalUnion if you want to avoid this copy." + + self + assert: [type referentClass includesBehavior: ExternalUnion] + description: 'Wrong type'. + + ^ self at: 1! Item was added: + ----- Method: ExternalData>>signedByteAt: (in category 'accessing - atomic values') ----- + signedByteAt: index + + ^ self + assert: ExternalType signedByte + at: index! Item was added: + ----- Method: ExternalData>>signedByteAt:put: (in category 'accessing - atomic values') ----- + signedByteAt: index put: value + + ^ self + assert: ExternalType signedByte + at: index + put: value! Item was added: + ----- Method: ExternalData>>signedCharAt: (in category 'accessing - atomic values') ----- + signedCharAt: index + + ^ self + assert: ExternalType signedChar + at: index! Item was added: + ----- Method: ExternalData>>signedCharAt:put: (in category 'accessing - atomic values') ----- + signedCharAt: index put: value + + ^ self + assert: ExternalType signedChar + at: index + put: value! Item was added: + ----- Method: ExternalData>>signedLongAt: (in category 'accessing - atomic values') ----- + signedLongAt: index + + ^ self + assert: ExternalType signedLong + at: index! Item was added: + ----- Method: ExternalData>>signedLongAt:put: (in category 'accessing - atomic values') ----- + signedLongAt: index put: value + + ^ self + assert: ExternalType signedLong + at: index + put: value! Item was added: + ----- Method: ExternalData>>signedLongLongAt: (in category 'accessing - atomic values') ----- + signedLongLongAt: index + + ^ self + assert: ExternalType signedLongLong + at: index! Item was added: + ----- Method: ExternalData>>signedLongLongAt:put: (in category 'accessing - atomic values') ----- + signedLongLongAt: index put: value + + ^ self + assert: ExternalType signedLongLong + at: index + put: value! Item was added: + ----- Method: ExternalData>>signedShortAt: (in category 'accessing - atomic values') ----- + signedShortAt: index + + ^ self + assert: ExternalType signedShort + at: index! Item was added: + ----- Method: ExternalData>>signedShortAt:put: (in category 'accessing - atomic values') ----- + signedShortAt: index put: value + + ^ self + assert: ExternalType signedShort + at: index + put: value! Item was added: + ----- Method: ExternalData>>unsignedByteAt: (in category 'accessing - atomic values') ----- + unsignedByteAt: index + + ^ self + assert: ExternalType unsignedByte + at: index! Item was added: + ----- Method: ExternalData>>unsignedByteAt:put: (in category 'accessing - atomic values') ----- + unsignedByteAt: index put: value + + ^ self + assert: ExternalType unsignedByte + at: index + put: value! Item was added: + ----- Method: ExternalData>>unsignedCharAt: (in category 'accessing - atomic values') ----- + unsignedCharAt: index + + ^ self + assert: ExternalType unsignedChar + at: index! Item was added: + ----- Method: ExternalData>>unsignedCharAt:put: (in category 'accessing - atomic values') ----- + unsignedCharAt: index put: value + + ^ self + assert: ExternalType unsignedChar + at: index + put: value! Item was added: + ----- Method: ExternalData>>unsignedLongAt: (in category 'accessing - atomic values') ----- + unsignedLongAt: index + + ^ self + assert: ExternalType unsignedLong + at: index! Item was added: + ----- Method: ExternalData>>unsignedLongAt:put: (in category 'accessing - atomic values') ----- + unsignedLongAt: index put: value + + ^ self + assert: ExternalType unsignedLong + at: index + put: value! Item was added: + ----- Method: ExternalData>>unsignedLongLongAt: (in category 'accessing - atomic values') ----- + unsignedLongLongAt: index + + ^ self + assert: ExternalType unsignedLongLong + at: index! Item was added: + ----- Method: ExternalData>>unsignedLongLongAt:put: (in category 'accessing - atomic values') ----- + unsignedLongLongAt: index put: value + + ^ self + assert: ExternalType unsignedLongLong + at: index + put: value! Item was added: + ----- Method: ExternalData>>unsignedShortAt: (in category 'accessing - atomic values') ----- + unsignedShortAt: index + + ^ self + assert: ExternalType unsignedShort + at: index! Item was added: + ----- Method: ExternalData>>unsignedShortAt:put: (in category 'accessing - atomic values') ----- + unsignedShortAt: index put: value + + ^ self + assert: ExternalType unsignedShort + at: index + put: value! Item was added: + ----- Method: ExternalData>>voidAt: (in category 'accessing - atomic values') ----- + voidAt: index + "no accessors for void" + ^self shouldNotImplement! Item was added: + ----- Method: ExternalData>>voidAt:put: (in category 'accessing - atomic values') ----- + voidAt: index put: value + "no accessors for void" + ^self shouldNotImplement! Item was added: + ----- Method: ExternalStructure>>asExternalData (in category 'converting') ----- + asExternalData + + ^ ExternalData fromHandle: self getHandle type: self externalType! Item was added: + ----- Method: ExternalStructure>>asExternalStructure (in category 'converting') ----- + asExternalStructure + + ^ self! Item was added: + ----- Method: ExternalStructure>>asExternalUnion (in category 'converting') ----- + asExternalUnion + + ^ self! Item was added: + ----- Method: ExternalType>>handle:at: (in category 'external data') ----- + handle: handle at: byteOffset + "Read the receiver's external type using the given handle and the byteOffset. This is the dynamic version of #readFieldAt:." + + | result | + self isPointerType ifTrue: [ + | accessor shouldReadCString | + accessor := self pointerSize caseOf: { + [4] -> [#shortPointerAt:]. + [8] -> [#longPointerAt:] }. + shouldReadCString := self = ExternalType string. + ^ referentClass + ifNil: [ + result := ExternalData + fromHandle: (handle perform: accessor with: byteOffset) + type: self. + shouldReadCString + ifTrue: [result fromCString] + ifFalse: [result]] + ifNotNil: [ + referentClass + fromHandle: (handle perform: accessor with: byteOffset)]]. + + self isAtomic ifFalse: [ "structure type" + ^ referentClass fromHandle: (handle structAt: byteOffset length: self byteSize)]. + + result := handle + perform: (AtomicSelectors at: self atomicType) + with: byteOffset. + + ^ self isTypeAlias + ifFalse: [result] "atomic type" + ifTrue: [referentClass fromHandle: result] "alias to atomic type"! Item was added: + ----- Method: ExternalType>>handle:at:put: (in category 'external data') ----- + handle: handle at: byteOffset put: value + "Write a value using the receiver's external type at the given handle and byteOffset. This is the dynamic version of #writeFieldAt:with:." + + self isPointerType ifTrue: [ + | accessor | + accessor := self pointerSize caseOf: { + [4] -> [#shortPointerAt:put:]. + [8] -> [#longPointerAt:put:] }. + self = ExternalType string + ifTrue: [^ self error: 'You should not write a string of arbitrary length into an external address.']. + ^ handle + perform: accessor + with: byteOffset + with: value getHandle]. + + self isAtomic ifFalse: [ "structure type" + ^ handle + structAt: byteOffset + put: value getHandle + length: self byteSize]. + + self isTypeAlias ifTrue: [ "alias to atomic type" + ^ handle + perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol + with: byteOffset + with: value getHandle]. + + "atomic type" + ^ handle + perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol + with: byteOffset + with: value! Item was changed: + ----- Method: ExternalType>>readAlias (in category 'external structure') ----- - ----- Method: ExternalType>>readAlias (in category 'private') ----- readAlias ^ String streamContents: [:s | referentClass == nil ifTrue:[(self isAtomic and:[self isPointerType not]) ifTrue:[s nextPutAll:'^handle "', self writeFieldArgName, '"'] ifFalse:[ | shouldReadCString | (shouldReadCString := self = ExternalType string) ifTrue: [s nextPutAll: '^('] ifFalse: [s nextPutAll: '^']. s nextPutAll: 'ExternalData fromHandle: handle'. self isPointerType ifTrue:[s nextPutAll:' asExternalPointer']. s nextPutAll:' type: '. shouldReadCString ifTrue: [s nextPutAll: 'ExternalType string) fromCString'] ifFalse: [s nextPutAll: self asPointerType storeString]]] ifFalse:[s nextPutAll:'^', referentClass name,' fromHandle: handle'. self isPointerType ifTrue:[s nextPutAll:' asExternalPointer']]]! Item was changed: + ----- Method: ExternalType>>readFieldAt: (in category 'external structure') ----- - ----- Method: ExternalType>>readFieldAt: (in category 'private') ----- readFieldAt: byteOffset "Answer a string defining the accessor to an entity of the receiver type starting at the given byte offset. Private. Used for field definition only." self isPointerType ifTrue: [| accessor shouldReadCString | self flag: #ffiLongVsInt. "mt: Here short means 'long', which is actually 'int', and long means 'longlong'. Sigh." accessor := self pointerSize caseOf: { [4] -> [#shortPointerAt:]. [8] -> [#longPointerAt:] }. shouldReadCString := self = ExternalType string. ^String streamContents: [:s| referentClass ifNil: [shouldReadCString ifTrue: [s nextPutAll: '^('] ifFalse: [s nextPutAll: '^']. s nextPutAll: 'ExternalData fromHandle: (handle ', accessor, ' '; print: byteOffset; nextPutAll: ') type: ExternalType '. shouldReadCString ifTrue: [s nextPutAll: 'string) fromCString'] ifFalse: [s nextPutAll: self atomicTypeName; nextPutAll: ' asPointerType']] ifNotNil: [s nextPutAll: '^'; print: referentClass; nextPutAll: ' fromHandle: (handle ', accessor, ' '; print: byteOffset; nextPut: $)]]]. self isAtomic ifFalse: "structure type" [^String streamContents:[:s| s nextPutAll:'^'; print: referentClass; nextPutAll:' fromHandle: (handle structAt: '; print: byteOffset; nextPutAll:' length: '; print: self byteSize; nextPutAll:')']]. self isTypeAlias ifTrue: "alias to atomic type" [^String streamContents:[:s | s nextPutAll:'^'; print: referentClass; nextPutAll:' fromHandle: (handle '; nextPutAll: (AtomicSelectors at: self atomicType); space; print: byteOffset; nextPutAll:')']]. "Atomic non-pointer types" ^String streamContents: [:s| s nextPutAll:'^handle '; nextPutAll: (AtomicSelectors at: self atomicType); space; print: byteOffset].! Item was changed: + ----- Method: ExternalType>>writeAliasWith: (in category 'external structure') ----- - ----- Method: ExternalType>>writeAliasWith: (in category 'private') ----- writeAliasWith: valueName ^ String streamContents: [:s | (referentClass == nil and:[self isAtomic and:[self isPointerType not]]) ifTrue:[s nextPutAll:'handle := ', valueName, '.'] ifFalse:[ self = ExternalType string ifTrue: [ s nextPutAll: 'self shouldNotImplement. "You cannot write an arbitrary String object into an external address. Maybe we can pad or trim it in the future to only use the memory that has already been allocated. Additionally, this type alias to a char* stores its external address in a byte array. So, locally storing the string in a byte array will not work either, because we cannot discriminate when reading the field again."'; crtab. s nextPutAll: 'handle := ', valueName, ' asByteArray, #[0].'] ifFalse: [ s nextPutAll:'handle := ', valueName,' getHandle'. self isPointerType ifTrue:[s nextPutAll:' asByteArrayPointer']]]]! Item was changed: + ----- Method: ExternalType>>writeFieldArgName (in category 'external structure') ----- - ----- Method: ExternalType>>writeFieldArgName (in category 'private') ----- writeFieldArgName ^ referentClass == nil ifTrue:[(self isAtomic and:[self isPointerType not]) ifTrue:[ self atomicTypeName caseOf: { ['bool'] -> ['aBoolean']. ['char'] -> ['aCharacter']. ['schar'] -> ['aCharacter']. ['float'] -> ['aFloat']. ['double'] -> ['aFloat']. } otherwise: ['anInteger']] ifFalse:[ self = ExternalType string ifTrue: ['aString'] ifFalse: ['someExternalData']]] ifFalse:['a',referentClass name]! Item was changed: + ----- Method: ExternalType>>writeFieldAt:with: (in category 'external structure') ----- - ----- Method: ExternalType>>writeFieldAt:with: (in category 'private') ----- writeFieldAt: byteOffset with: valueName "Answer a string defining the accessor to an entity of the receiver type starting at the given byte offset. Private. Used for field definition only." self isPointerType ifTrue: [| accessor | self flag: #ffiLongVsInt. "mt: Here short means 'long', which is actually 'int', and long means 'longlong'. Sigh." accessor := self pointerSize caseOf: { [4] -> [#shortPointerAt:]. [8] -> [#longPointerAt:] }. ^String streamContents: [:s| self = ExternalType string ifTrue: [s nextPutAll: 'self shouldNotImplement. "You should not write a string of abitrary length into an external address. Maybe we can pad or trim it in the future to only use the memory that has already been allocated."'] ifFalse: [s nextPutAll:'handle ', accessor, ' '; print: byteOffset; nextPutAll:' put: '; nextPutAll: valueName; nextPutAll:' getHandle.']]]. self isAtomic ifFalse:[ "structure type" ^String streamContents:[:s| s nextPutAll:'handle structAt: '; print: byteOffset; nextPutAll:' put: '; nextPutAll: valueName; nextPutAll:' getHandle'; nextPutAll:' length: '; print: self byteSize; nextPutAll:'.']]. self isTypeAlias ifTrue:[ "alias to atomic type" ^String streamContents:[:s| s nextPutAll:'handle '; nextPutAll: (AtomicSelectors at: self atomicType); space; print: byteOffset; nextPutAll:' put: '; nextPutAll: valueName; nextPutAll: ' getHandle']]. ^String streamContents:[:s| s nextPutAll:'handle '; nextPutAll: (AtomicSelectors at: self atomicType); space; print: byteOffset; nextPutAll:' put: '; nextPutAll: valueName].!

1 0

The Trunk: MorphicExtras-kfr.275.mcz
by commits＠source.squeak.org 13 Jun '20

13 Jun '20

Karl Ramberg uploaded a new version of MorphicExtras to project The Trunk: http://source.squeak.org/trunk/MorphicExtras-kfr.275.mcz ==================== Summary ==================== Name: MorphicExtras-kfr.275 Author: kfr Time: 10 June 2020, 6:41:33.727777 pm UUID: 26fa97c9-e242-8048-8c7c-53b2061c19f4 Ancestors: MorphicExtras-mt.274 Detect if animated image (eg. gif) has transparent color and use opaque background if so. =============== Diff against MorphicExtras-mt.274 =============== Item was changed: ----- Method: AnimatedImageMorph>>fromReader: (in category 'private') ----- fromReader: reader - images := reader forms. delays := reader delays. + images do:[: each | (each colors includes: Color transparent) ifTrue:[self isOpaque: true]]. - self isOpaque: true. self reset.!

1 0

The Trunk: Tools-mt.979.mcz
by commits＠source.squeak.org 13 Jun '20

13 Jun '20

Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-mt.979.mcz ==================== Summary ==================== Name: Tools-mt.979 Author: mt Time: 13 June 2020, 12:51:14.17003 pm UUID: fb7f5dec-3bab-fe4f-85ab-46727f2ec91b Ancestors: Tools-mt.978 In the deps browser, auto-select the string that most like represents the class dependency. Selects the wrong thing in the text when the name is also part of some other identifier. =============== Diff against Tools-mt.978 =============== Item was changed: CodeHolder subclass: #DependencyBrowser + instanceVariableNames: 'packageList packageDeps packageDepsList classDeps classDepsList classList messageList packageListIndex packageDepsIndex classDepsIndex classListIndex messageListIndex autoSelectString' - instanceVariableNames: 'packageList packageDeps packageDepsList classDeps classDepsList classList messageList packageListIndex packageDepsIndex classDepsIndex classListIndex messageListIndex' classVariableNames: '' poolDictionaries: '' category: 'Tools-Browser'! !DependencyBrowser commentStamp: 'fbs 5/6/2011 11:29' prior: 0! A simple dependency browser showing five panes: [1]: Packages: The list of available packages in the system. [2]: Package Dependencies: The dependent packages of the currently selected package. [3]: Class Dependencies: The classes causing the dependencies. [4]: Class List: The classes introducing the dependencies. [5]: Messages: The messages introducing the dependencies.! Item was added: + ----- Method: DependencyBrowser>>autoSelectString (in category 'accessing') ----- + autoSelectString + ^ autoSelectString! Item was added: + ----- Method: DependencyBrowser>>autoSelectString: (in category 'accessing') ----- + autoSelectString: aString + autoSelectString := aString. + self changed: #contentsSelection.! Item was added: + ----- Method: DependencyBrowser>>contentsSelection (in category 'accessing') ----- + contentsSelection + + ^ self autoSelectString + ifNil: [super contentsSelection] + ifNotNil: [:term | | index | + (index := self contents asString findString: term) > 0 + ifTrue: [index to: index + term size - 1] + ifFalse: [super contentsSelection]]! Item was changed: ----- Method: DependencyBrowser>>messageListIndex: (in category 'message list') ----- messageListIndex: idx "Message list selection" messageListIndex := idx. self changed: #messageListIndex. self changed: #contents. + self changed: #annotation. + + self autoSelectString: self classDepsSelection.! - self changed: #annotation.!

1 0

FFI: FFI-Pools-mt.25.mcz
by commits＠source.squeak.org 13 Jun '20

13 Jun '20

Marcel Taeumel uploaded a new version of FFI-Pools to project FFI: http://source.squeak.org/FFI/FFI-Pools-mt.25.mcz ==================== Summary ==================== Name: FFI-Pools-mt.25 Author: mt Time: 13 June 2020, 12:30:34.49703 pm UUID: 1c28eee9-bee2-424c-ac81-21a11db9073b Ancestors: FFI-Pools-mt.24 Removes code-loading dependency to Json class. Note that there is #ensureParsingSupport to lazy-load the Json class. =============== Diff against FFI-Pools-mt.24 =============== Item was changed: ----- Method: ExternalPoolJSONReadWriter>>interpretPoolData (in category 'reading - fetch/interpret/clear/load') ----- interpretPoolData + poolData := (self environment classNamed: #Json) readFrom: poolData readStream. - poolData := Json readFrom: poolData readStream. poolData at: 1 put: (FFIPlatformDescription name: (poolData first at: 'name') osVersion: (poolData first at: 'osVersion') subtype: (poolData first at: 'subtype') wordSize: (poolData first at: 'wordSize')). poolData second keysAndValuesDo: [:name :value | "See #nextPutFloatVariable:from:. We have to read a Float from the string contents." (poolDefinition variablesAndTypesAt: name) value == Float ifTrue: [poolData second at: name put: (self class readFloatFrom: value readStream)]].!

1 0

The Trunk: Tools-mt.978.mcz
by commits＠source.squeak.org 13 Jun '20

13 Jun '20

Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-mt.978.mcz ==================== Summary ==================== Name: Tools-mt.978 Author: mt Time: 13 June 2020, 12:12:13.228814 pm UUID: 2b303276-0f03-1643-80da-7a436f6d2f89 Ancestors: Tools-mt.977 In the deps browser, reveal whether there is any class-definition or extension dependency at all as early as possible. Feel free to adjust the labels. For now, they are: 2nd / 3rd pane ... () ... * ... () * ... *exts only ... (defs only) 4th pane: ... (class definition) *extensions =============== Diff against Tools-mt.977 =============== Item was changed: ----- Method: DependencyBrowser>>classDepsList (in category 'class deps') ----- classDepsList "Class dependencies for the currently selected package" + | checkDef checkExt | + checkDef := [:mref | mref selector = #Definition]. + checkExt := [:mref | mref category notNil and: [mref category first = $*]]. + ^ classDepsList ifNil: [ classDepsList := self classDeps. classDepsList := classDepsList collect: [:className | + String streamContents: [:label | + label nextPutAll: className. + (self depsForClassNamed: className allSatisfy: checkDef) + ifTrue: [label nextPutAll: ' (defs only)'] + ifFalse: [(self depsForClassNamed: className allSatisfy: checkExt) + ifTrue: [label nextPutAll: ' *exts only'] + ifFalse: [ + (self depsForClassNamed: className anySatisfy: checkDef) + ifTrue: [label nextPutAll: ' ()']. + (self depsForClassNamed: className anySatisfy: checkExt) + ifTrue: [label nextPutAll: ' *']]]]]]! - (self - depsForClassNamed: className - allSatisfy: [:mref | mref selector = #Definition]) - ifTrue: [className, ' (defs only)'] - ifFalse: [(self - depsForClassNamed: className - allSatisfy: [:mref | mref category notNil and: [mref category first = $*]]) - ifTrue: [className, ' *ext only*'] - ifFalse: [className]]]. - classDepsList]! Item was added: + ----- Method: DependencyBrowser>>depsForClassNamed:anySatisfy: (in category 'enumerating') ----- + depsForClassNamed: className anySatisfy: workBlock + + self + depsForClassNamed: className + do: [:mref | (workBlock value: mref) ifTrue: [^ true]]. + ^ false! Item was added: + ----- Method: DependencyBrowser>>depsForPackageNamed:anySatisfy: (in category 'enumerating') ----- + depsForPackageNamed: packageName anySatisfy: workBlock + + self + depsForPackageNamed: packageName + do: [:mref | (workBlock value: mref) ifTrue: [^ true]]. + ^ false! Item was changed: ----- Method: DependencyBrowser>>packageDepsList (in category 'package deps') ----- packageDepsList "Package dependencies for the currently selected package" + | checkDef checkExt | + checkDef := [:mref | mref selector = #Definition]. + checkExt := [:mref | mref category notNil and: [mref category first = $*]]. + ^ packageDepsList ifNil: [ packageDepsList := self packageDeps. packageDepsList := packageDepsList collect: [:packageName | + String streamContents: [:label | + label nextPutAll: packageName. + (self depsForPackageNamed: packageName allSatisfy: checkDef) + ifTrue: [label nextPutAll: ' (defs only)'] + ifFalse: [(self depsForPackageNamed: packageName allSatisfy: checkExt) + ifTrue: [label nextPutAll: ' *exts only'] + ifFalse: [ + (self depsForPackageNamed: packageName anySatisfy: checkDef) + ifTrue: [label nextPutAll: ' ()']. + (self depsForPackageNamed: packageName anySatisfy: checkExt) + ifTrue: [label nextPutAll: ' *']]]]]]! - (self - depsForPackageNamed: packageName - allSatisfy: [:mref | mref selector = #Definition]) - ifTrue: [packageName, ' (defs only)'] - ifFalse: [(self - depsForPackageNamed: packageName - allSatisfy: [:mref | mref category notNil and: [mref category first = $*]]) - ifTrue: [packageName, ' *ext only*'] - ifFalse: [packageName]]]. - packageDepsList]!

1 0

The Trunk: System-dtl.1165.mcz
by commits＠source.squeak.org 13 Jun '20

13 Jun '20

David T. Lewis uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-dtl.1165.mcz ==================== Summary ==================== Name: System-dtl.1165 Author: dtl Time: 12 June 2020, 9:56:28.877275 pm UUID: 939daf88-a16b-4749-b905-cbd7f529d0c3 Ancestors: System-dtl.1164 Fix a bug introduced in the last commit. If the readDocumentAtStartup preference is disabled, then adjust image argument list accordingly. =============== Diff against System-dtl.1164 =============== Item was changed: ----- Method: SmalltalkImage>>arguments (in category 'command line') ----- arguments "Answer an array with all the command line arguments. This does not include imagePath, documentPath nor any option." "Smalltalk commandLine arguments" | args strm | args := self rawArguments. (args includes: '--') ifTrue: [ ^args copyAfter: self imageArgumentsMarker ]. strm := args readStream. strm atEnd ifFalse: [ strm next. "skip image name" + (Preferences readDocumentAtStartup and: [ strm atEnd not ]) + ifTrue: [ strm next "skip startup document name" ]]. - strm atEnd ifFalse: [ strm next "skip startup document name" ] ]. ^ strm upToEnd. ! Item was changed: + ----- Method: SmalltalkImage>>rawArguments (in category 'private') ----- - ----- Method: SmalltalkImage>>rawArguments (in category 'command line') ----- rawArguments "Answer an array with all the command line arguments as delivered from the VM. Any arguments for the VM itself will have been removed (these are accessed with optionAt:)." "Smalltalk commandLine rawArguments" ^Array streamContents: [:str | | arg i | i := 1. [i > 998 or: [(arg := self getSystemAttribute: i) == nil]] whileFalse: [str nextPut: arg. i := i + 1]].!

1 0

FFI: FFI-PoolsTests-mt.10.mcz
by commits＠source.squeak.org 12 Jun '20

12 Jun '20

Marcel Taeumel uploaded a new version of FFI-PoolsTests to project FFI: http://source.squeak.org/FFI/FFI-PoolsTests-mt.10.mcz ==================== Summary ==================== Name: FFI-PoolsTests-mt.10 Author: mt Time: 12 June 2020, 7:45:27.681226 pm UUID: 1edfe0bd-67f6-1e4d-ba6a-78e01548af1d Ancestors: FFI-PoolsTests-mt.9 Complements FFI-Kernel-mt.105 =============== Diff against FFI-PoolsTests-mt.9 =============== Item was changed: ----- Method: FFIExternalSharedPoolTest>>testInheritance (in category 'tests') ----- testInheritance | sharedPool definitions defaultDefinition emptyDefinition overrideDefinition | sharedPool := FFITestInheritanceExternalSharedPool. definitions := self resolvedDefinitionsFor: sharedPool. self assert: definitions size equals: 3. defaultDefinition := definitions detect: [:each | each isDefault]. emptyDefinition := definitions detect: [:each | each name = #empty]. overrideDefinition := definitions detect: [:each | each name = #override]. self assertIsDefaultDefinition: defaultDefinition for: sharedPool. self deny: emptyDefinition isDefault; assert: emptyDefinition inheritsFrom isNil; assert: emptyDefinition cCompiler equals: defaultDefinition cCompiler; assert: emptyDefinition cFlags equals: defaultDefinition cFlags; assert: emptyDefinition cHeaders equals: defaultDefinition cHeaders; assert: emptyDefinition platform equals: defaultDefinition platform; assert: emptyDefinition poolReadWriterClass equals: defaultDefinition poolReadWriterClass; assert: emptyDefinition variablesAndTypes equals: defaultDefinition variablesAndTypes. self deny: overrideDefinition isDefault; assert: overrideDefinition inheritsFrom equals: #empty; assert: overrideDefinition cCompiler equals: 'testCompiler'; assert: overrideDefinition cFlags equals: 'testFlags'; assert: overrideDefinition cHeaders equals: #('<testHeader.h>' '"testLocalHeader.h"' '<testImplicitGlobalHeader.h>'); assert: overrideDefinition platform equals: self newTestPlatform; assert: overrideDefinition variablesAndTypes + equals: (Dictionary withAll: {#One -> ((ExternalType typeNamed: 'float') -> Float). #Two -> ((ExternalType typeNamed: 'long') -> Integer)}).! - equals: (Dictionary withAll: {#One -> ((ExternalType atomicTypeNamed: 'float') -> Float). #Two -> ((ExternalType atomicTypeNamed: 'long') -> Integer)}).!

1 0

FFI: FFI-Pools-mt.24.mcz
by commits＠source.squeak.org 12 Jun '20

12 Jun '20

Marcel Taeumel uploaded a new version of FFI-Pools to project FFI: http://source.squeak.org/FFI/FFI-Pools-mt.24.mcz ==================== Summary ==================== Name: FFI-Pools-mt.24 Author: mt Time: 12 June 2020, 7:45:06.896226 pm UUID: 2ab6b122-4784-e946-9e91-938ca2b01957 Ancestors: FFI-Pools-mt.23 Complements FI-Kernel-mt.105 =============== Diff against FFI-Pools-mt.23 =============== Item was changed: ----- Method: ExternalPoolDefinition>>ffiVariable:type:convertTo: (in category 'pragmas') ----- ffiVariable: aVariableName type: aVariableTypeName convertTo: aClassName | externalType targetClassName targetClass | "0) Skip variables with nil type." aVariableTypeName ifNil: [ ^ self variablesAndTypesAt: aVariableName put: nil]. "1) Look up external type from type name." targetClassName := aClassName. + externalType := (ExternalType typeNamed: aVariableTypeName) - externalType := (ExternalType atomicTypeNamed: aVariableTypeName) ifNil: [ "Backwards compatiblility only. Try to not write class names as <... type: ...>." targetClassName := aVariableTypeName. self externalTypeForClassName: aVariableTypeName]. "2) Look up class in current environment." targetClass := (self environment classNamed: targetClassName) ifNil: [ ExternalPoolError signal: 'Cannot convert to ', aClassName, ' from C type; ', 'no matching Smalltalk class found']. "3) Try to specialize conversion class." (externalType = ExternalType float or: [externalType = ExternalType double]) ifTrue: [(Float includesBehavior: targetClass) ifTrue: [targetClass := Float]]. (externalType = ExternalType char asPointerType) ifTrue: [(String includesBehavior: targetClass) ifTrue: [targetClass := String]]. "4) Store the resulting type spec for pool read-writers to use." self variablesAndTypesAt: aVariableName put: externalType -> targetClass.!

1 0

FFI: FFI-Kernel-mt.105.mcz
by commits＠source.squeak.org 12 Jun '20

12 Jun '20

Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.105.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.105 Author: mt Time: 12 June 2020, 7:44:46.025226 pm UUID: f8493ed8-b9dc-494c-b072-eba13f606180 Ancestors: FFI-Kernel-mt.104 Code clean up. Make #atomicTypeName and #atomicTypeNamed: behave the same, i.e., no pointer (*) support. =============== Diff against FFI-Kernel-mt.104 =============== Item was changed: ----- Method: ExternalType class>>atomicTypeNamed: (in category 'instance lookup') ----- atomicTypeNamed: typeName + "If not found, look up 'type constants' protocol as lightweight alias to atomic type." - "Supports pointer-type lookup such as for 'long*' and also 'long *'." - - | isPointerType actualTypeName type | - (isPointerType := typeName last == $*) - ifTrue: [actualTypeName := typeName allButLast withoutTrailingBlanks] - ifFalse: [actualTypeName := typeName]. + ^ AtomicTypes + at: typeName + ifAbsent: [ + (self class includesSelector: typeName) + ifTrue: [self perform: typeName]]! - (Symbol lookup: actualTypeName) - ifNotNil: [:sym | actualTypeName := sym]. - - ^ (type := (AtomicTypes at: actualTypeName ifAbsent: [nil]) - ifNil: [ "Supports 'type constants' protocol of ExternalTypes." - (self class includesSelector: actualTypeName) - ifTrue: [self perform: actualTypeName]]) - ifNotNil: [isPointerType ifTrue: [type asPointerType] ifFalse: [type]]! Item was changed: ----- Method: ExternalType class>>c_ulong (in category 'type constants - extra') ----- c_ulong "Try to approximate a fitting type for 'usigned long' in a C interface. See comment in #c_long." + ^ self typeNamed: 'u', self c_long atomicTypeName! - ^ self atomicTypeNamed: 'u', self c_long atomicTypeName! Item was changed: + ----- Method: ExternalType class>>string (in category 'type constants - extra') ----- - ----- Method: ExternalType class>>string (in category 'type constants') ----- string ^ self char asPointerType! Item was changed: ----- Method: ExternalType class>>structTypeNamed: (in category 'instance lookup') ----- structTypeNamed: typeName "Answers the external type for the struct named typeName. If there is no type yet, create a new one but only if typeName can be matched to an existing class in the system already. If you still need a type even if there is no such class present, use #newTypeNamed: to create a type with an unknown referent class." - - "Supports pointer-type lookup such as for 'MyStruct*' and also 'MyStruct *'." + ^ (StructTypes at: typeName ifAbsent: [nil]) + ifNil: [ "Create struct types for existing struct classes on-the-fly." + (self environment classNamed: typeName) - | isPointerType actualTypeName type | - (isPointerType := typeName last == $*) - ifTrue: [actualTypeName := typeName allButLast withoutTrailingBlanks] - ifFalse: [actualTypeName := typeName]. - - (Symbol lookup: actualTypeName) - ifNotNil: [:sym | actualTypeName := sym]. - - type := (StructTypes at: actualTypeName ifAbsent: [nil]) - ifNil: [ - (self environment classNamed: actualTypeName) ifNotNil: [:cls | (cls includesBehavior: ExternalStructure) ifTrue: [ + StructTypes removeKey: typeName ifAbsent: []. + self newTypeNamed: typeName]]]! - StructTypes removeKey: actualTypeName ifAbsent: []. - self newTypeNamed: actualTypeName]]]. - - ^ type ifNotNil: [isPointerType ifTrue: [type asPointerType] ifFalse: [type]]! Item was changed: ----- Method: ExternalType class>>typeNamed: (in category 'instance lookup') ----- typeNamed: typeName + "Supports pointer-type lookup for both atomic and structure types. + Examples: 'long', 'long*', 'long *' or 'MyStruct', 'MyStruct*', 'MyStruct *'" + + | isPointerType actualTypeName type | + (isPointerType := typeName last == $*) + ifTrue: [actualTypeName := typeName allButLast withoutTrailingBlanks] + ifFalse: [actualTypeName := typeName]. + (Symbol lookup: actualTypeName) + ifNotNil: [:sym | actualTypeName := sym]. - (self atomicTypeNamed: typeName) - ifNotNil: [:type | ^ type]. - (self structTypeNamed: typeName) - ifNotNil: [:type | ^ type]. + type := (self atomicTypeNamed: actualTypeName) + ifNil: [self structTypeNamed: actualTypeName]. + + ^ type ifNotNil: [isPointerType ifTrue: [type asPointerType] ifFalse: [type]]! - ^ nil!

1 0

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

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages June 2020