Squeak-dev June 2020

squeak-dev@lists.squeakfoundation.org

43 participants
346 discussions

The Trunk: EToys-mt.395.mcz
by commits＠source.squeak.org 03 Jun '20

03 Jun '20

Marcel Taeumel uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-mt.395.mcz ==================== Summary ==================== Name: EToys-mt.395 Author: mt Time: 3 June 2020, 3:24:51.881117 pm UUID: b4c7142d-c357-3448-86fd-62a029de049d Ancestors: EToys-mt.394 Fixes for the original chess game. Adds the revised version, Chess 960, to Etoys games catalogue. Also available through the parts bin. Thanks to Stéphane (spfa)! Bugfixes: - castling was not possible when a rook was menaced - a test for king attack in black king-side castling was missing - the cached number of pawns is sometimes off, which could lead to a DivideByZero error in some endgames (this is fixed, but not the discrepancy which still effects the material evaluation) - a pawn taken en-passant was not removed from display One notable bug left is that undoing a castling move makes it impossible to castle again. Improvements: - nicer display, scalable (with assets from wikimedia common) - the board is now sticky and cannot be accidentally grabbed - hints (from the 'help' button) now appear in the status line - support for Fischer randomized chess, aka Chess960 Changes: - to castle, one now has to move the king over the rook =============== Diff against EToys-mt.394 =============== Item was changed: SystemOrganization addCategory: #'Etoys-Buttons'! SystemOrganization addCategory: #'Etoys-CustomEvents'! SystemOrganization addCategory: #'Etoys-Experimental'! SystemOrganization addCategory: #'Etoys-OLPC-Display'! SystemOrganization addCategory: #'Etoys-Outliner'! SystemOrganization addCategory: #'Etoys-Protocols'! SystemOrganization addCategory: #'Etoys-Protocols-Type Vocabularies'! SystemOrganization addCategory: #'Etoys-ReleaseBuilder'! SystemOrganization addCategory: #'Etoys-Scripting'! SystemOrganization addCategory: #'Etoys-Scripting Support'! SystemOrganization addCategory: #'Etoys-Scripting Tiles'! SystemOrganization addCategory: #'Etoys-Squeakland-BroomMorphs-Base'! SystemOrganization addCategory: #'Etoys-Squeakland-BroomMorphs-Connectors'! SystemOrganization addCategory: #'Etoys-Squeakland-EToys-Kedama'! SystemOrganization addCategory: #'Etoys-Squeakland-Etoys-Buttons'! SystemOrganization addCategory: #'Etoys-Squeakland-Etoys-Calendar'! SystemOrganization addCategory: #'Etoys-Squeakland-Etoys-Debugger'! SystemOrganization addCategory: #'Etoys-Squeakland-Etoys-Help'! SystemOrganization addCategory: #'Etoys-Squeakland-Etoys-Input'! SystemOrganization addCategory: #'Etoys-Squeakland-Etoys-Scripting'! SystemOrganization addCategory: #'Etoys-Squeakland-Etoys-Scripting Support'! SystemOrganization addCategory: #'Etoys-Squeakland-Etoys-Scripting Tiles'! SystemOrganization addCategory: #'Etoys-Squeakland-Etoys-SpeechBubbles'! SystemOrganization addCategory: #'Etoys-Squeakland-Etoys-Tile Scriptors'! SystemOrganization addCategory: #'Etoys-Squeakland-Graphics-Text'! SystemOrganization addCategory: #'Etoys-Squeakland-Graphics-Tools-Intersection'! SystemOrganization addCategory: #'Etoys-Squeakland-Graphics-Tools-Simplification'! SystemOrganization addCategory: #'Etoys-Squeakland-Graphics-Tools-Triangulation'! SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Basic'! SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Books'! SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Components'! SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Demo'! SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Experimental'! SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Games'! SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Games-Chess'! SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-GeeMail'! SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Kernel'! SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Mentoring'! SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Navigators'! SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-PDA'! SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-PartsBin'! SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Support'! SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Widgets'! SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Windows'! SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Worlds'! SystemOrganization addCategory: #'Etoys-Squeakland-MorphicExtras-AdditionalMorphs'! SystemOrganization addCategory: #'Etoys-Squeakland-MorphicExtras-Charts'! SystemOrganization addCategory: #'Etoys-Squeakland-MorphicExtras-Postscript Filters'! SystemOrganization addCategory: #'Etoys-Squeakland-MorphicExtras-WebCam'! SystemOrganization addCategory: #'Etoys-Squeakland-MorphicExtras-Widgets'! SystemOrganization addCategory: #'Etoys-Squeakland-Multilingual-Languages'! SystemOrganization addCategory: #'Etoys-Squeakland-Multilingual-TextConversion'! SystemOrganization addCategory: #'Etoys-Squeakland-Network-HTML-Formatter'! SystemOrganization addCategory: #'Etoys-Squeakland-Network-HTML-Forms'! SystemOrganization addCategory: #'Etoys-Squeakland-Network-HTML-Parser'! SystemOrganization addCategory: #'Etoys-Squeakland-Network-HTML-Parser Entities'! SystemOrganization addCategory: #'Etoys-Squeakland-Network-HTML-Tokenizer'! SystemOrganization addCategory: #'Etoys-Squeakland-Network-MIME'! SystemOrganization addCategory: #'Etoys-Squeakland-Network-TelNet WordNet'! SystemOrganization addCategory: #'Etoys-Squeakland-Network-UI'! SystemOrganization addCategory: #'Etoys-Squeakland-Network-Url'! SystemOrganization addCategory: #'Etoys-Squeakland-Protocols-Type Vocabularies'! SystemOrganization addCategory: #'Etoys-Squeakland-SISS-Serialization'! SystemOrganization addCategory: #'Etoys-Squeakland-ST80-Morphic'! SystemOrganization addCategory: #'Etoys-Squeakland-SUnit'! SystemOrganization addCategory: #'Etoys-Squeakland-Sound-Interface'! SystemOrganization addCategory: #'Etoys-Squeakland-Sound-Ogg'! SystemOrganization addCategory: #'Etoys-Squeakland-Sound-Scores'! SystemOrganization addCategory: #'Etoys-Squeakland-Sugar'! SystemOrganization addCategory: #'Etoys-Squeakland-Support'! SystemOrganization addCategory: #'Etoys-Squeakland-System-Clipboard-Extended'! SystemOrganization addCategory: #'Etoys-Squeakland-System-Compiler'! SystemOrganization addCategory: #'Etoys-Squeakland-System-Exceptions Kernel'! SystemOrganization addCategory: #'Etoys-Squeakland-System-Support'! SystemOrganization addCategory: #'Etoys-Squeakland-Tools-Changes'! SystemOrganization addCategory: #'Etoys-Squeakland-Tools-Explorer'! SystemOrganization addCategory: #'Etoys-Squeakland-Tools-Process Browser'! SystemOrganization addCategory: #'Etoys-Squeakland-Tweak-Kedama-ObjectVectors'! SystemOrganization addCategory: #'Etoys-Squeakland-Tweak-Kedama-ParseTree-AttributeDefinition'! SystemOrganization addCategory: #'Etoys-Squeakland-Tweak-Kedama-ParseTreeTransformer'! SystemOrganization addCategory: #'Etoys-Stacks'! SystemOrganization addCategory: #'Etoys-StarSqueak'! SystemOrganization addCategory: #'Etoys-Support'! SystemOrganization addCategory: #'Etoys-Tests'! SystemOrganization addCategory: #'Etoys-Tile Scriptors'! SystemOrganization addCategory: #'Etoys-UserInterfaceTheme'! SystemOrganization addCategory: #'Etoys-Widgets'! + SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Games-Chess960'! Item was added: + ChessBoard subclass: #Chess960Board + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Etoys-Squeakland-Morphic-Games-Chess960'! + + !Chess960Board commentStamp: 'spfa 6/2/2020 15:13' prior: 0! + Chess960Board can handle Fisher-style random starting positions in home ranks! Item was added: + ----- Method: Chess960Board>>initialize (in category 'initialize') ----- + initialize + generator ifNil:[generator := Chess960MoveGenerator new initialize]. + searchAgent ifNil:[searchAgent := ChessPlayerAI new initialize]. + self resetGame. + ! Item was added: + ----- Method: Chess960Board>>initializeNewBoard (in category 'initialize') ----- + initializeNewBoard + + | conf | + + self resetGame. + conf := Chess960Configuration new. + whitePlayer addWhitePieces: conf. + blackPlayer addBlackPieces: conf. + ! Item was added: + ----- Method: Chess960Board>>resetGame (in category 'initialize') ----- + resetGame + hashKey := hashLock := 0. + whitePlayer := Chess960Player new initialize. + blackPlayer := Chess960Player new initialize. + whitePlayer opponent: blackPlayer. + whitePlayer board: self. + blackPlayer opponent: whitePlayer. + blackPlayer board: self. + activePlayer := whitePlayer. + searchAgent reset: self. + userAgent ifNotNil:[userAgent gameReset].! Item was added: + Object subclass: #Chess960Configuration + instanceVariableNames: 'positions king leftRook rightRook' + classVariableNames: '' + poolDictionaries: 'ChessConstants' + category: 'Etoys-Squeakland-Morphic-Games-Chess960'! + + !Chess960Configuration commentStamp: 'spfa 6/2/2020 15:13' prior: 0! + A Chess960Configuration is a Fisher-style random starting arrangement of pieces in the home ranks! Item was added: + ----- Method: Chess960Configuration class>>new (in category 'as yet unclassified') ----- + new + + | rand positions k | + + rand := Random new. + positions := Array new: 8. + positions at: (rand nextInt: 4) * 2 - 1 put: Bishop. + positions at: (rand nextInt: 4) * 2 put: Bishop. + positions at: (k := (((1 to: 8) select: [:n | (positions at: n) isNil]) copyFrom: 2 to: 5) atRandom: rand) put: King. + positions at: (((1 to: k-1) select: [:n | (positions at: n) isNil]) atRandom: rand) put: Rook. + positions at: (((k+1 to: 8) select: [:n | (positions at: n) isNil]) atRandom: rand) put: Rook. + positions at: (((1 to: 8) select: [:n | (positions at: n) isNil]) atRandom: rand) put: Queen. + positions at: ((1 to: 8) detect: [:n | (positions at: n) isNil]) put: Knight. + positions at: ((1 to: 8) detect: [:n | (positions at: n) isNil]) put: Knight. + + ^ self basicNew positions: positions + ! Item was added: + ----- Method: Chess960Configuration>>initialKingPosition (in category 'positions') ----- + initialKingPosition + + ^ king ifNil: [king := positions indexOf: King]! Item was added: + ----- Method: Chess960Configuration>>initialLeftRookPosition (in category 'positions') ----- + initialLeftRookPosition + + ^ leftRook ifNil: [leftRook := positions indexOf: Rook]! Item was added: + ----- Method: Chess960Configuration>>initialRightRookPosition (in category 'positions') ----- + initialRightRookPosition + + ^ rightRook ifNil: [rightRook := positions indexOf: Rook startingAt: self initialKingPosition]! Item was added: + ----- Method: Chess960Configuration>>positions (in category 'positions') ----- + positions + + ^ positions! Item was added: + ----- Method: Chess960Configuration>>positions: (in category 'positions') ----- + positions: anArray + + positions := anArray. + king := leftRook := rightRook := nil! Item was added: + ChessMorph subclass: #Chess960Morph + instanceVariableNames: 'images message squareSize' + classVariableNames: '' + poolDictionaries: '' + category: 'Etoys-Squeakland-Morphic-Games-Chess960'! + + !Chess960Morph commentStamp: 'spfa 6/2/2020 15:10' prior: 0! + Chess960Morph is a nicer, scalable, skin for ChessMorph. + It also can play Fischer random chess (use the '960' button) + + Chess960Morph new openInWorld + + (Chess960Morph new squareSize: 100) openInWorld + ! Item was added: + ----- Method: Chess960Morph class>>descriptionForPartsBin (in category 'parts bin') ----- + descriptionForPartsBin + ^ self partName: 'Chess 960' translatedNoop + categories: {'Games' translatedNoop} + documentation: 'A fine game of chess. Revised by Stéphane Rollandin (spfa).' translatedNoop! Item was added: + ----- Method: Chess960Morph>>addButtonRow (in category 'initialize') ----- + addButtonRow + + | r m | + r := AlignmentMorph newRow hResizing: #shrinkWrap; vResizing: #shrinkWrap; color: Color transparent. + r cellInset: 2. + r addMorphBack: (self buttonName: ' New ' translated action: #newGame). + r addMorphBack: (self buttonName: ' 960 ' translated action: #new960Game). + r addMorphBack: (self buttonName: ' Help ' translated action: #findBestMove). + r addMorphBack: (self buttonName: ' Play ' translated action: #thinkAndMove). + r addMorphBack: (self buttonName: ' Auto ' translated action: #autoPlay). + r addMorphBack: (self buttonName: ' Undo ' translated action: #undoMove). + r addMorphBack: (self buttonName: ' Redo ' translated action: #redoMove). + r addMorphBack: (self buttonName: ' Quit ' translated action: #delete). + r disableTableLayout: true. + r align: r bounds topLeft with: self layoutBounds topLeft. + self addMorphFront: r. + m := UpdatingStringMorph on: self selector: #statusString. + m useStringFormat. + m disableTableLayout: true. + m stepTime: 50. + m align: m bounds topLeft with: r fullBounds bottomLeft. + self addMorphFront: m. + m + font: self textFont; + color: self statusColor; + maximumWidth: self width - self squareSize; + position: self position + (self squareSize @ self squareSize * 0.6)! Item was added: + ----- Method: Chess960Morph>>addSquares (in category 'initialize') ----- + addSquares + | white black border square index | + white := self whiteColor. + black := self blackColor. + border := self highColor. + index := 0. + #( + ( ' ' 'a' 'b' 'c' 'd' 'e' 'f' 'g' 'h' ' ') + ( '1' 'B' 'W' 'B' 'W' 'B' 'W' 'B' 'W' ' ') + ( '2' 'W' 'B' 'W' 'B' 'W' 'B' 'W' 'B' ' ') + ( '3' 'B' 'W' 'B' 'W' 'B' 'W' 'B' 'W' ' ') + ( '4' 'W' 'B' 'W' 'B' 'W' 'B' 'W' 'B' ' ') + ( '5' 'B' 'W' 'B' 'W' 'B' 'W' 'B' 'W' ' ') + ( '6' 'W' 'B' 'W' 'B' 'W' 'B' 'W' 'B' ' ') + ( '7' 'B' 'W' 'B' 'W' 'B' 'W' 'B' 'W' ' ') + ( '8' 'W' 'B' 'W' 'B' 'W' 'B' 'W' 'B' ' ') + ( ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ') + ) do:[:file| + file do:[:sq| + square := self newSquare. + square borderWidth: 0. + (sq = 'W' or:[sq = 'B']) ifTrue:[ + square color: (sq = 'W' ifTrue:[white] ifFalse:[black]). + square borderColor: border. + square setProperty: #squarePosition toValue: (index := index + 1). + square setNameTo: + (String with: ($a asInteger + (index - 1 bitAnd: 7)) asCharacter with: ($1 asInteger + (index -1 bitShift: -3)) asCharacter). + square on: #mouseEnter send: #showMoves:from: to: self. + square on: #mouseEnterDragging send: #dragSquareEnter:from: to: self. + square on: #mouseLeaveDragging send: #dragSquareLeave:from: to: self. + ] ifFalse:["decoration" + square color: Color transparent. + sq = ' ' ifFalse:[ + square addMorph: ((StringMorph contents: sq font: self textFont) + color: self labelsColor). + ]. + ]. + square extent: self squareSize @ self squareSize. + self addMorphBack: square. + square submorphs ifNotEmpty: [square submorphs first center: square center] + ]]. + ! Item was added: + ----- Method: Chess960Morph>>blackColor (in category 'theme') ----- + blackColor + + " Color earth paler duller." + "^ Color grass duller" + ^ Color r: 0.343 g: 0.576 b: 0.207! Item was added: + ----- Method: Chess960Morph>>buttonColor (in category 'theme') ----- + buttonColor + + " ^ Color lightBlue3 whiter " + ^ Color r: 0.667 g: 0.792 b: 0.833! Item was added: + ----- Method: Chess960Morph>>buttonName:action: (in category 'initialize') ----- + buttonName: aString action: aSymbol + + ^ SimpleButtonMorph new + target: self; + label: aString; + actionSelector: aSymbol; + color: self buttonColor; + borderWidth: 1; + borderRaised. + ! Item was added: + ----- Method: Chess960Morph>>defaultBounds (in category 'initialization') ----- + defaultBounds + "answer the default bounds for the receiver" + ^ 0 @ 0 corner: (self squareSize * 10 + 10) @ (self squareSize * 10 + 10)! Item was added: + ----- Method: Chess960Morph>>defaultColor (in category 'theme') ----- + defaultColor + + "^ Color paleTeal duller duller" + ^ Color r: 0.467 g: 0.631 b: 0.71! Item was added: + ----- Method: Chess960Morph>>findBestMove (in category 'playing') ----- + findBestMove + | move | + board ifNil: [^ self]. + board searchAgent isThinking ifTrue:[^self]. + + "tmp - board should be nil when the game is over" + ((1 to: 64) allSatisfy: [:n | + (board activePlayer pieces at: n) isZero + or: [(board activePlayer findValidMovesAt: n) isEmpty]]) + ifTrue: [message := (board activePlayer isWhitePlayer + ifTrue: ['white'] ifFalse: ['black']), ' lost'. + ^ self]. + + Cursor wait showWhile:[move := board searchAgent think]. + message := 'I suggest ' translated, move moveString. + ^move + ! Item was added: + ----- Method: Chess960Morph>>finishedGame: (in category 'as yet unclassified') ----- + finishedGame: result + + super finishedGame: result. + message := #('black won' 'draw' 'white won') at: result * 2 + 1! Item was added: + ----- Method: Chess960Morph>>highColor (in category 'theme') ----- + highColor + + " ^ Color lightGold" + ^ Color r: 0.992 g: 0.863 b: 0.361! Item was added: + ----- Method: Chess960Morph>>images (in category 'theme') ----- + images + + ^ images ifNil: [images := ChessPieceMorphWC piecesWithHeight: self squareSize - 5]! Item was added: + ----- Method: Chess960Morph>>initialize (in category 'initialization') ----- + initialize + "initialize the state of the receiver" + super initialize. + self bounds: self defaultBounds. + self beSticky! Item was added: + ----- Method: Chess960Morph>>labelsColor (in category 'theme') ----- + labelsColor + + " ^ Color armyGreen" + ^ Color r: 0.294 g: 0.365 b: 0.086! Item was added: + ----- Method: Chess960Morph>>movedPiece:from:to: (in category 'game callbacks') ----- + movedPiece: piece from: sourceSquare to: destSquare + | sourceMorph destMorph sourcePos destPos w startTime nowTime deltaTime | + sourceMorph := (self atSquare: sourceSquare) firstSubmorph. + destMorph := self atSquare: destSquare. + animateMove ifTrue:[ + sourcePos := sourceMorph boundsInWorld center. + destPos := destMorph boundsInWorld center. + (w := self world) ifNotNil:[ + w addMorphFront: sourceMorph. + deltaTime := (sourcePos dist: destPos) * 3 asInteger. + startTime := Time millisecondClockValue. + [nowTime := Time millisecondClockValue. + nowTime - startTime < deltaTime] whileTrue:[ + sourceMorph center: sourcePos + (destPos - sourcePos * (nowTime - startTime) // deltaTime) asIntegerPoint. + w displayWorldSafely]. + sourceMorph removeDropShadow. + ]. + ]. + destMorph removeAllMorphs. + destMorph addMorphCentered: sourceMorph. + animateMove := false. + message := nil.! Item was added: + ----- Method: Chess960Morph>>new960Game (in category 'initialize') ----- + new960Game + board := Chess960Board new. + board initialize. + board userAgent: self. + board initializeNewBoard. + history := OrderedCollection new. + redoList := OrderedCollection new. + message := nil + ! Item was added: + ----- Method: Chess960Morph>>newPiece:white: (in category 'initialize') ----- + newPiece: piece white: isWhite + + | index selector m | + index := piece. + isWhite ifFalse:[index := index + 6]. + selector := #( + whitePawn + whiteKnight + whiteBishop + whiteRook + whiteQueen + whiteKing + + blackPawn + blackKnight + blackBishop + blackRook + blackQueen + blackKing) at: index. + m := ChessPieceMorph new image: (self images at: selector). + m setProperty: #isWhite toValue: isWhite. + m setProperty: #piece toValue: piece. + ^m! Item was added: + ----- Method: Chess960Morph>>reinstallPieces (in category 'resizing') ----- + reinstallPieces + + board whitePlayer pieces doWithIndex: [:pc :n | + pc isZero ifFalse: [ + self addedPiece: pc at: n white: true]]. + + board blackPlayer pieces doWithIndex: [:pc :n | + pc isZero ifFalse: [ + self addedPiece: pc at: n white: false]].! Item was added: + ----- Method: Chess960Morph>>setExtentFromHalo: (in category 'miscellaneous') ----- + setExtentFromHalo: anExtent + + self squareSize: (anExtent x - 10) //10.! Item was added: + ----- Method: Chess960Morph>>showMovesAt: (in category 'events') ----- + showMovesAt: square + | list | + board ifNil:[^self]. + board searchAgent isThinking ifTrue:[^self]. + self squaresDo:[:m| m borderWidth: 0]. + list := board activePlayer findValidMovesAt: square. + list isEmpty ifTrue:[^self]. + (self atSquare: square) borderWidth: 2. + list do:[:move| + (self atSquare: (move triggerSquareIn: board)) borderWidth: 5. + ].! Item was added: + ----- Method: Chess960Morph>>squareSize (in category 'resizing') ----- + squareSize + + ^ squareSize ifNil: [70]! Item was added: + ----- Method: Chess960Morph>>squareSize: (in category 'resizing') ----- + squareSize: anInteger + + | ss | + + ss := anInteger max: 48. + + squareSize := ss. + images := nil. + submorphs do: #delete. + self extent: (ss * 10 + 10) @ (ss * 10 + 10) . + self addSquares. + self addButtonRow. + self reinstallPieces! Item was added: + ----- Method: Chess960Morph>>statusColor (in category 'theme') ----- + statusColor + + " ^ Color reallyLightBlue " + ^ Color r: 0.831 g: 1 b: 1! Item was added: + ----- Method: Chess960Morph>>statusString (in category 'other stuff') ----- + statusString + + ^ message ifNil: [super statusString]! Item was added: + ----- Method: Chess960Morph>>swappedPieceOn:withPieceOn: (in category 'game callbacks') ----- + swappedPieceOn: aSquare withPieceOn: bSquare + | aMorph bMorph | + + aMorph := (self atSquare: aSquare) firstSubmorph. + bMorph := (self atSquare: bSquare) firstSubmorph. + + (self atSquare: aSquare) removeAllMorphs. + (self atSquare: aSquare) addMorphCentered: bMorph. + + (self atSquare: bSquare) removeAllMorphs. + (self atSquare: bSquare) addMorphCentered: aMorph. + + message := nil.! Item was added: + ----- Method: Chess960Morph>>textFont (in category 'theme') ----- + textFont + + | ps | + + ps := self squareSize < 80 ifTrue: [12] ifFalse: [15]. + + ^ TTCFont familyName: 'BitstreamVeraSans' pointSize: ps emphasis: 1 + ! Item was added: + ----- Method: Chess960Morph>>whiteColor (in category 'theme') ----- + whiteColor + + " ^ Color ivory" + ^ Color r: 1 g: 1 b: 0.94! Item was added: + ChessMoveGenerator subclass: #Chess960MoveGenerator + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Etoys-Squeakland-Morphic-Games-Chess960'! + + !Chess960MoveGenerator commentStamp: 'spfa 6/1/2020 14:56' prior: 0! + Chess960MoveGenerator implements the specific castling checks and moves for Chess960! Item was added: + ----- Method: Chess960MoveGenerator>>canCastleBlackKingSide (in category 'support') ----- + canCastleBlackKingSide + + (castlingStatus bitAnd: CastlingEnableKingSide) = 0 ifFalse:[^false]. + + (myPlayer rightCastlingField inject: 0 into: [:sum :s| + sum + (myPieces at: s) + (itsPieces at: s)]) = (King + Rook) + ifFalse:[^false]. + + myPlayer rightCastlingWalk in: [:w | + (self checkRookMoversAttacksAlong: w) ifTrue: [^false]. + (self checkBishopMoversAttacksAlong: w) ifTrue: [^ false]. + (self checkKnightAttacksAlong: w) ifTrue: [^ false]. + (self checkPawnsAttacksAlong: w) ifTrue: [^ false]. + (self checkKingAttacksAlong: w) ifTrue: [^ false]]. + + (self checkAttack: (myPlayer initialKingSquare - 1 to: A8 by: -1) fromPieces: RookMovers) + ifTrue: [^false]. + (self checkAttack: {H8} fromPieces: RookMovers) ifTrue: [^false]. + + ^true. + + + + + ! Item was added: + ----- Method: Chess960MoveGenerator>>canCastleBlackQueenSide (in category 'support') ----- + canCastleBlackQueenSide + + (castlingStatus bitAnd: CastlingEnableQueenSide) = 0 ifFalse:[^false]. + + (myPlayer leftCastlingField inject: 0 into: [:sum :s| + sum + (myPieces at: s) + (itsPieces at: s)]) = (King + Rook) + ifFalse:[^false]. + + myPlayer leftCastlingWalk in: [:w | + (self checkRookMoversAttacksAlong: w) ifTrue: [^false]. + (self checkBishopMoversAttacksAlong: w) ifTrue: [^ false]. + (self checkKnightAttacksAlong: w) ifTrue: [^ false]. + (self checkPawnsAttacksAlong: w) ifTrue: [^ false]. + (self checkKingAttacksAlong: w) ifTrue: [^ false]]. + + (self checkAttack: (myPlayer initialKingSquare +1 to: H8) fromPieces: RookMovers) + ifTrue: [^false]. + (self checkAttack: {B8 . A8} fromPieces: RookMovers) ifTrue: [^false]. + + + ^true. + + + + + ! Item was added: + ----- Method: Chess960MoveGenerator>>canCastleWhiteKingSide (in category 'support') ----- + canCastleWhiteKingSide + + (castlingStatus bitAnd: CastlingEnableKingSide) = 0 ifFalse:[^false]. + + (myPlayer rightCastlingField inject: 0 into: [:sum :s| + sum + (myPieces at: s) + (itsPieces at: s)]) = (King + Rook) + ifFalse:[^false]. + + myPlayer rightCastlingWalk in: [:w | + (self checkRookMoversAttacksAlong: w) ifTrue: [^false]. + (self checkBishopMoversAttacksAlong: w) ifTrue: [^ false]. + (self checkKnightAttacksAlong: w) ifTrue: [^ false]. + (self checkPawnsAttacksAlong: w) ifTrue: [^ false]. + (self checkKingAttacksAlong: w) ifTrue: [^ false]]. + + (self checkAttack: (myPlayer initialKingSquare - 1 to: A1 by: -1) fromPieces: RookMovers) + ifTrue: [^false]. + (self checkAttack: {H1} fromPieces: RookMovers) ifTrue: [^false]. + + ^true. + + + + + ! Item was added: + ----- Method: Chess960MoveGenerator>>canCastleWhiteQueenSide (in category 'support') ----- + canCastleWhiteQueenSide + + (castlingStatus bitAnd: CastlingEnableQueenSide) = 0 ifFalse:[^false]. + + (myPlayer leftCastlingField inject: 0 into: [:sum :s| + sum + (myPieces at: s) + (itsPieces at: s)]) = (King + Rook) + ifFalse:[^false]. + + myPlayer leftCastlingWalk in: [:w | + (self checkRookMoversAttacksAlong: w) ifTrue: [^false]. + (self checkBishopMoversAttacksAlong: w) ifTrue: [^ false]. + (self checkKnightAttacksAlong: w) ifTrue: [^ false]. + (self checkPawnsAttacksAlong: w) ifTrue: [^ false]. + (self checkKingAttacksAlong: w) ifTrue: [^ false]]. + + (self checkAttack: (myPlayer initialKingSquare + 1 to: H1) fromPieces: RookMovers) + ifTrue: [^false]. + (self checkAttack: {B1 . A1} fromPieces: RookMovers) ifTrue: [^false]. + + ^true. + + + + + ! Item was added: + ----- Method: Chess960MoveGenerator>>checkBishopMoversAttacksAlong: (in category 'support') ----- + checkBishopMoversAttacksAlong: anArray + + "anArray contains consecutive, ordered squares that are all either in rank 8 or in rank 1" + + anArray do: [:s | + (self checkBishopMoversAttacksOn: s) ifTrue: [^ true]]. + + ^ false! Item was added: + ----- Method: Chess960MoveGenerator>>checkBishopMoversAttacksOn: (in category 'support') ----- + checkBishopMoversAttacksOn: aSquare + + "aSquare is either in rank 8 or in rank 1" + + | leftDiagonal rightDiagonal | + + myPlayer isWhitePlayer ifFalse: [ + leftDiagonal := (1 to: aSquare - A8) collect: [:n | aSquare - (n * 7)]. + rightDiagonal := (1 to: H8 - aSquare) collect: [:n | aSquare - (n * 9)] + ] + ifTrue: [ + leftDiagonal := (1 to: aSquare - A1) collect: [:n | aSquare + (n * 7)]. + rightDiagonal := (1 to: H1 - aSquare) collect: [:n | aSquare + (n * 9)] + ]. + + ^ (self checkAttack: leftDiagonal fromPieces: BishopMovers) + or: [self checkAttack: rightDiagonal fromPieces: BishopMovers]! Item was added: + ----- Method: Chess960MoveGenerator>>checkKingAttacksAlong: (in category 'support') ----- + checkKingAttacksAlong: anArray + + "anArray contains consecutive, ordered squares that are all either in rank 8 or in rank 1" + + | kpos | + + "somewhat overkill because some positions can never be reached by opponent king" + kpos := Array streamContents: [:str | + str nextPut: anArray first - 1. + str nextPutAll: anArray. + str nextPut: anArray last + 1]. + + ^ self checkUnprotectedAttack: + (kpos + (myPlayer isWhitePlayer ifTrue: [8] ifFalse: [-8])) + fromPiece: King! Item was added: + ----- Method: Chess960MoveGenerator>>checkKnightAttacksAlong: (in category 'support') ----- + checkKnightAttacksAlong: anArray + + "anArray contains consecutive, ordered squares that are all either in rank 8 or in rank 1" + + | kpos1 kpos2 | + + "rank at distance 1" + kpos1 := (anArray - 2) union: (anArray + 2). + + myPlayer isWhitePlayer ifTrue: [ + kpos1 min = 0 ifTrue: [kpos1 := kpos1 copyWithout: 0]. + kpos1 max = 9 ifTrue: [kpos1 := kpos1 copyWithout: 9]]. + + (self checkUnprotectedAttack: + (kpos1 + (myPlayer isWhitePlayer ifTrue: [8] ifFalse: [-8])) + fromPiece: Knight) ifTrue: [^ true]. + + "rank at distance 2 - same logic as for pawns at distance 1" + kpos2 := Array streamContents: [:str | + str nextPut: anArray min - 1. + anArray size > 1 ifTrue: [str nextPutAll: anArray]. + str nextPut: anArray max + 1]. + + ^ self checkUnprotectedAttack: + (kpos2 + (myPlayer isWhitePlayer ifTrue: [16] ifFalse: [-16])) + fromPiece: Knight! Item was added: + ----- Method: Chess960MoveGenerator>>checkPawnsAttacksAlong: (in category 'support') ----- + checkPawnsAttacksAlong: anArray + + "anArray contains consecutive, ordered squares that are all either in rank 8 or in rank 1" + + | ppos | + + ppos := Array streamContents: [:str | + str nextPut: anArray first - 1. + "If the king does not move, castling is not prevented by a pawn in same file" + anArray size > 1 ifTrue: [str nextPutAll: anArray]. + str nextPut: anArray last + 1]. + + ^ self checkUnprotectedAttack: + (ppos + (myPlayer isWhitePlayer ifTrue: [8] ifFalse: [-8])) + fromPiece: Pawn! Item was added: + ----- Method: Chess960MoveGenerator>>checkRookMoversAttacksAlong: (in category 'support') ----- + checkRookMoversAttacksAlong: anArray + + "anArray contains consecutive, ordered squares that are all either in rank 8 or in rank 1" + + anArray first > 8 ifTrue: [ "black" + anArray do: [:s | + (self checkAttack: {s-8. s-16. s-24. s-32. s-40. s-48. s-56} fromPieces: RookMovers) + ifTrue: [^ true]]. + ^ false]. + + "white" + anArray do: [:s | + (self checkAttack: {s+8. s+16. s+24. s+32. s+40. s+48. s+56} fromPieces: RookMovers) + ifTrue: [^ true]]. + ^ false + ! Item was added: + ----- Method: Chess960MoveGenerator>>moveBlackKingAt: (in category 'moves-general') ----- + moveBlackKingAt: square + | capture | + (KingMoves at: square) do:[:destSquare| + (myPieces at: destSquare) = 0 ifTrue:[ + capture := itsPieces at: destSquare. + (forceCaptures and:[capture = 0]) ifFalse:[ + (moveList at: (lastMoveIndex := lastMoveIndex + 1)) + move: King from: square to: destSquare capture: capture. + capture = King ifTrue:[kingAttack := moveList at: lastMoveIndex]. + ]. + ]. + ]. + forceCaptures ifTrue:[^self]. + "now consider castling" + self canCastleBlackKingSide ifTrue:[ + (moveList at: (lastMoveIndex := lastMoveIndex + 1)) + moveCastlingKingSide: King from: square to: G8 + ]. + self canCastleBlackQueenSide ifTrue:[ + (moveList at: (lastMoveIndex := lastMoveIndex + 1)) + moveCastlingQueenSide: King from: square to: C8 + ].! Item was added: + ----- Method: Chess960MoveGenerator>>moveWhiteKingAt: (in category 'moves-general') ----- + moveWhiteKingAt: square + | capture | + (KingMoves at: square) do:[:destSquare| + (myPieces at: destSquare) = 0 ifTrue:[ + capture := itsPieces at: destSquare. + (forceCaptures and:[capture = 0]) ifFalse:[ + (moveList at: (lastMoveIndex := lastMoveIndex + 1)) + move: King from: square to: destSquare capture: capture. + capture = King ifTrue:[kingAttack := moveList at: lastMoveIndex]. + ]. + ]. + ]. + forceCaptures ifTrue:[^self]. + "now consider castling" + self canCastleWhiteKingSide ifTrue:[ + (moveList at: (lastMoveIndex := lastMoveIndex + 1)) + moveCastlingKingSide: King from: square to: G1. + ]. + self canCastleWhiteQueenSide ifTrue:[ + (moveList at: (lastMoveIndex := lastMoveIndex + 1)) + moveCastlingQueenSide: King from: square to: C1. + ].! Item was added: + ChessPlayer subclass: #Chess960Player + instanceVariableNames: 'configuration' + classVariableNames: '' + poolDictionaries: '' + category: 'Etoys-Squeakland-Morphic-Games-Chess960'! + + !Chess960Player commentStamp: 'spfa 6/2/2020 15:16' prior: 0! + Chess960Player represents a Chess960 player (doh)! Item was added: + ----- Method: Chess960Player>>addBlackPieces: (in category 'adding/removing') ----- + addBlackPieces: aChess960Configuration + + self configuration: aChess960Configuration. + + configuration positions doWithIndex: [:p :n | self addPiece: p at: 56+n]. + 49 to: 56 do:[:i| self addPiece: Pawn at: i].! Item was added: + ----- Method: Chess960Player>>addWhitePieces: (in category 'adding/removing') ----- + addWhitePieces: aChess960Configuration + + self configuration: aChess960Configuration. + + configuration positions doWithIndex: [:p :n | self addPiece: p at: n]. + 9 to: 16 do:[:i| self addPiece: Pawn at: i]. + ! Item was added: + ----- Method: Chess960Player>>applyCastleKingSideMove: (in category 'moving') ----- + applyCastleKingSideMove: move + + (pieces at: move destinationSquare) isZero "rook" ifFalse: [ + castlingRookSquare := self isWhitePlayer ifTrue: [F1] ifFalse: [F8]. + move sourceSquare = castlingRookSquare + ifTrue: [ + self swapPiecesIn: move sourceSquare and: move destinationSquare] + ifFalse: [ + self movePiece: Rook from: self initialRightRookSquare to: castlingRookSquare. + self movePiece: King from: move sourceSquare to: move destinationSquare]. + castlingStatus := castlingStatus bitOr: CastlingDone. + ^ self]. + + self movePiece: move movingPiece from: move sourceSquare to: move destinationSquare. + self movePiece: Rook + from: self initialRightRookSquare + to: ((castlingRookSquare := self isWhitePlayer ifTrue: [F1] ifFalse: [F8])). + pieces at: castlingRookSquare put: King. + castlingStatus := castlingStatus bitOr: CastlingDone.! Item was added: + ----- Method: Chess960Player>>applyCastleQueenSideMove: (in category 'moving') ----- + applyCastleQueenSideMove: move + + (pieces at: move destinationSquare) isZero "rook or king" ifFalse: [ + castlingRookSquare := self isWhitePlayer ifTrue: [D1] ifFalse: [D8]. + move sourceSquare = castlingRookSquare + ifTrue: [ + self swapPiecesIn: move sourceSquare and: move destinationSquare] + ifFalse: [ + self movePiece: Rook + from: self initialLeftRookSquare to: castlingRookSquare. + self movePiece: King from: move sourceSquare to: move destinationSquare]. + castlingStatus := castlingStatus bitOr: CastlingDone. + ^ self]. + + self movePiece: move movingPiece from: move sourceSquare to: move destinationSquare. + self movePiece: Rook + from: self initialLeftRookSquare + to: (castlingRookSquare := self isWhitePlayer ifTrue: [D1] ifFalse: [D8]). + pieces at: castlingRookSquare put: King. + castlingStatus := castlingStatus bitOr: CastlingDone.! Item was added: + ----- Method: Chess960Player>>configuration (in category 'configuration') ----- + configuration + + ^ configuration! Item was added: + ----- Method: Chess960Player>>configuration: (in category 'configuration') ----- + configuration: aChess960Configuration + + configuration := aChess960Configuration! Item was added: + ----- Method: Chess960Player>>copyPlayer: (in category 'copying') ----- + copyPlayer: aPlayer + + super copyPlayer: aPlayer. + configuration := aPlayer configuration! Item was added: + ----- Method: Chess960Player>>initialKingSquare (in category 'configuration') ----- + initialKingSquare + + ^ self isWhitePlayer ifTrue: [self configuration initialKingPosition] + ifFalse: [self configuration initialKingPosition + 56]! Item was added: + ----- Method: Chess960Player>>initialLeftRookSquare (in category 'configuration') ----- + initialLeftRookSquare + + ^ self isWhitePlayer ifTrue: [self configuration initialLeftRookPosition] + ifFalse: [self configuration initialLeftRookPosition + 56]! Item was added: + ----- Method: Chess960Player>>initialRightRookSquare (in category 'configuration') ----- + initialRightRookSquare + + ^ self isWhitePlayer ifTrue: [self configuration initialRightRookPosition] + ifFalse: [self configuration initialRightRookPosition + 56]! Item was added: + ----- Method: Chess960Player>>leftCastlingField (in category 'configuration') ----- + leftCastlingField + + "The squares walked by both the king and the left rook when castling to the left - they must be clear of other pieces" + + ^ self isWhitePlayer + ifTrue: [(C1 to: self initialKingSquare) union: (self initialLeftRookSquare to: D1)] + ifFalse: [(C8 to: self initialKingSquare) union: (self initialLeftRookSquare to: D8)] + ! Item was added: + ----- Method: Chess960Player>>leftCastlingWalk (in category 'configuration') ----- + leftCastlingWalk + + "The squares walked by the king when castling to the left - they must not be under check" + + | ks | + + ks := self initialKingSquare. + + ^ self isWhitePlayer + ifTrue: [ks > C1 ifTrue: [C1 to: ks] ifFalse: [ks to: C1]] + ifFalse: [ks > C8 ifTrue: [C8 to: ks] ifFalse: [ks to: C8]] ! Item was added: + ----- Method: Chess960Player>>movePiece:from:to: (in category 'adding/removing') ----- + movePiece: piece from: sourceSquare to: destSquare + + sourceSquare = destSquare ifTrue: [^ self]. + super movePiece: piece from: sourceSquare to: destSquare! Item was added: + ----- Method: Chess960Player>>rightCastlingField (in category 'configuration') ----- + rightCastlingField + + "The squares walked by both the king and the right rook when castling to the left - they must be clear of other pieces" + + ^ self isWhitePlayer + ifTrue: [(self initialKingSquare to: G1) union: (F1 to: self initialRightRookSquare)] + ifFalse: [(self initialKingSquare to: G8) union: (F8 to: self initialRightRookSquare)]! Item was added: + ----- Method: Chess960Player>>rightCastlingWalk (in category 'configuration') ----- + rightCastlingWalk + + "The squares walked by the king when castling to the right - they must not be under check" + + | ks | + + ks := self initialKingSquare. + + ^ self isWhitePlayer + ifTrue: [ks > G1 ifTrue: [G1 to: ks] ifFalse: [ks to: G1]] + ifFalse: [ks > G8 ifTrue: [G8 to: ks] ifFalse: [ks to: G8]] ! Item was added: + ----- Method: Chess960Player>>swapPiecesIn:and: (in category 'adding/removing') ----- + swapPiecesIn: aSquare and: bSquare + + "Only applies to specific castling moves" + + | score pa pb | + + pa := pieces at: aSquare. + pb := pieces at: bSquare. + + score := PieceCenterScores at: pa. + positionalValue := positionalValue - (score at: aSquare). + positionalValue := positionalValue + (score at: bSquare). + + score := PieceCenterScores at: pb. + positionalValue := positionalValue - (score at: bSquare). + positionalValue := positionalValue + (score at: aSquare). + + pieces at: aSquare put: pb. + pieces at: bSquare put: pa. + board updateHash: pa at: aSquare from: self. + board updateHash: pa at: bSquare from: self. + board updateHash: pb at: bSquare from: self. + board updateHash: pb at: aSquare from: self. + + self userAgent ifNotNil:[self userAgent swappedPieceOn: aSquare withPieceOn: bSquare].! Item was added: + ----- Method: Chess960Player>>undoCastleKingSideMove: (in category 'undo') ----- + undoCastleKingSideMove: move + self prepareNextMove. "in other words, remove extra kings" + self movePiece: move movingPiece from: move destinationSquare to: move sourceSquare. + + self isWhitePlayer ifTrue: [ + self movePiece: Rook from: F1 to: self initialRightRookPosition. + ] ifFalse: [ + self movePiece: Rook from: F8 to: self initialRightRookPosition + 56. + ] + + ! Item was added: + ----- Method: Chess960Player>>undoCastleQueenSideMove: (in category 'undo') ----- + undoCastleQueenSideMove: move + self prepareNextMove. "in other words, remove extra kings" + self movePiece: move movingPiece from: move destinationSquare to: move sourceSquare. + + self isWhitePlayer ifTrue: [ + self movePiece: Rook from: D1 to: self initialLeftRookPosition. + ] ifFalse: [ + self movePiece: Rook from: D8 to: self initialLeftRookPosition + 56. + ] + + ! Item was added: + ----- Method: Chess960Player>>updateCastlingStatus: (in category 'moving') ----- + updateCastlingStatus: move + + "Cannot castle when king has moved" + (move movingPiece = King) + ifTrue:[^castlingStatus := castlingStatus bitOr: CastlingDisableAll]. + + "See if a rook has moved" + (move movingPiece = Rook) ifFalse:[^self]. + + (move sourceSquare = self initialLeftRookSquare) + ifTrue:[^castlingStatus := castlingStatus bitOr: CastlingDisableQueenSide]. + + (move sourceSquare = self initialRightRookSquare) + ifTrue:[^castlingStatus := castlingStatus bitOr: CastlingDisableKingSide].! Item was changed: ----- Method: ChessBoard>>movePieceFrom:to: (in category 'moving') ----- movePieceFrom: sourceSquare to: destSquare | move | searchAgent isThinking ifTrue:[^self]. move := (activePlayer findPossibleMovesAt: sourceSquare) contents + detect:[:any| any destinationSquare = destSquare + or: [(any triggerSquareIn: self) = destSquare]]. - detect:[:any| any destinationSquare = destSquare]. self nextMove: move. searchAgent activePlayer: activePlayer.! Item was changed: ----- Method: ChessMorph>>showMovesAt: (in category 'events') ----- showMovesAt: square | list | board ifNil:[^self]. board searchAgent isThinking ifTrue:[^self]. self squaresDo:[:m| m borderWidth: 0]. list := board activePlayer findValidMovesAt: square. list isEmpty ifTrue:[^self]. (self atSquare: square) borderWidth: 1. list do:[:move| + (self atSquare: (move triggerSquareIn: board)) borderWidth: 1. - (self atSquare: move destinationSquare) borderWidth: 1. ].! Item was added: + ----- Method: ChessMove>>triggerSquareIn: (in category 'accessing') ----- + triggerSquareIn: aChessBoard + + type = MoveCastlingKingSide ifTrue: [^ aChessBoard activePlayer initialRightRookSquare]. + type = MoveCastlingQueenSide ifTrue: [^ aChessBoard activePlayer initialLeftRookSquare]. + + ^destinationSquare! Item was changed: ----- Method: ChessMoveGenerator>>canCastleBlackKingSide (in category 'support') ----- canCastleBlackKingSide (castlingStatus bitAnd: CastlingEnableKingSide) = 0 ifFalse:[^false]. "Quickly check if all the squares are zero" ((myPieces at: G8) + (myPieces at: F8) + (itsPieces at: G8) + (itsPieces at: F8) = 0) ifFalse:[^false]. "Check for castling squares under attack.. See canCastleBlackQueenSide for details" - (self checkAttack:{H7. H6. H5. H4. H3. H2. H1} fromPieces:RookMovers) ifTrue:[^false]. (self checkAttack:{G7. G6. G5. G4. G3. G2. G1} fromPieces:RookMovers) ifTrue:[^false]. (self checkAttack:{F7. F6. F5. F4. F3. F2. F1} fromPieces:RookMovers) ifTrue:[^false]. (self checkAttack:{E7. E6. E5. E4. E3. E2. E1.} fromPieces:RookMovers) ifTrue:[^false]. (self checkAttack:{D8. C8. B8. A8} fromPieces:RookMovers) ifTrue:[^false]. - (self checkAttack:{G7. F6. E5. D4. C3. B2. A1} fromPieces:BishopMovers) ifTrue:[^false]. (self checkAttack:{F7. E6. D5. C4. B3. A2} fromPieces:BishopMovers) ifTrue:[^false]. (self checkAttack:{E7. D6. C5. B4. A3} fromPieces:BishopMovers) ifTrue:[^false]. (self checkAttack:{D7. C6. B5. A4} fromPieces:BishopMovers) ifTrue:[^false]. (self checkAttack:{F7. G6. H5} fromPieces:BishopMovers) ifTrue:[^false]. (self checkAttack:{G7. H6} fromPieces:BishopMovers) ifTrue:[^false]. (self checkAttack:{H7} fromPieces:BishopMovers) ifTrue:[^false]. + (self checkUnprotectedAttack:{H7. G7. E7. D7. C7. H6. G6. F6. E6. D6} fromPiece:Knight) ifTrue:[^false]. - (self checkUnprotectedAttack:{H7. G7. F7. E7. D7. C7. H6. G6. F6. E6. D6} fromPiece:Knight) ifTrue:[^false]. (self checkUnprotectedAttack:{H7. G7. F7. E7. D7} fromPiece:Pawn) ifTrue:[^false]. + (self checkUnprotectedAttack:{G7} fromPiece:King) ifTrue:[^false]. + ^true. ! Item was changed: ----- Method: ChessMoveGenerator>>canCastleBlackQueenSide (in category 'support') ----- canCastleBlackQueenSide (castlingStatus bitAnd: CastlingEnableQueenSide) = 0 ifFalse:[^false]. "Quickly check if all the squares are zero" ((myPieces at: B8) + (myPieces at: C8) + (myPieces at: D8) + (itsPieces at: B8) + (itsPieces at: C8) + (itsPieces at: D8) = 0) ifFalse:[^false]. "Check to see if any of the squares involved in castling are under attack. First check for vertical (rook-like) attacks" - (self checkAttack:{A7. A6. A5. A4. A3. A2. A1} fromPieces:RookMovers) ifTrue:[^false]. (self checkAttack:{B7. B6. B5. B4. B3. B2. B1} fromPieces:RookMovers) ifTrue:[^false]. (self checkAttack:{C7. C6. C5. C4. C3. C2. C1} fromPieces:RookMovers) ifTrue:[^false]. (self checkAttack:{D7. D6. D5. D4. D3. D2. D1} fromPieces:RookMovers) ifTrue:[^false]. (self checkAttack:{E7. E6. E5. E4. E3. E2. E1} fromPieces:RookMovers) ifTrue:[^false]. "Check for a rook attack from the baseline" (self checkAttack:{F8. G8. H8} fromPieces:RookMovers) ifTrue:[^false]. "Check for bishop attacks from the diagonals" - (self checkAttack:{B7. C6. D5. E4. F3. G2. H1} fromPieces:BishopMovers) ifTrue:[^false]. (self checkAttack:{C7. D6. E5. F4. G3. H2} fromPieces:BishopMovers) ifTrue:[^false]. (self checkAttack:{D7. E6. F5. G4. H3} fromPieces:BishopMovers) ifTrue:[^false]. (self checkAttack:{E7. F6. G5. H4} fromPieces:BishopMovers) ifTrue:[^false]. (self checkAttack:{F7. G6. H5} fromPieces:BishopMovers) ifTrue:[^false]. (self checkAttack:{A7} fromPieces:BishopMovers) ifTrue:[^false]. (self checkAttack:{B7. A6} fromPieces:BishopMovers) ifTrue:[^false]. (self checkAttack:{C7. B6. A5} fromPieces:BishopMovers) ifTrue:[^false]. (self checkAttack:{D7. C6. B5. A4} fromPieces:BishopMovers) ifTrue:[^false]. "Check for a knight attack" (self checkUnprotectedAttack:{A7. B7. C7. D7. E7. F7. G7. A6. B6. C6. D6. E6. F6} fromPiece:Knight) ifTrue:[^false]. "check for a pawn attack" (self checkUnprotectedAttack:{A7. B7. C7. D7. E7. F7} fromPiece:Pawn) ifTrue:[^false]. "check for a king attack" (self checkUnprotectedAttack:{B7. C7. } fromPiece:King) ifTrue:[^false]. ^true. ! Item was changed: ----- Method: ChessMoveGenerator>>canCastleWhiteKingSide (in category 'support') ----- canCastleWhiteKingSide (castlingStatus bitAnd: CastlingEnableKingSide) = 0 ifFalse: [^false]. "Quickly check if all the squares are zero" ((myPieces at:G1) + (myPieces at:F1) + (itsPieces at:G1) + (itsPieces at:F1) = 0) ifFalse:[^false]. "Check for castling squares under attack.. See canCastleBlackQueenSide for details" - (self checkAttack:{H2. H3. H4. H5. H6. H7. H8} fromPieces:RookMovers) ifTrue:[^false]. (self checkAttack:{G2. G3. G4. G5. G6. G7. G8} fromPieces:RookMovers) ifTrue:[^false]. (self checkAttack:{F2. F3. F4. F5. F6. F7. F8} fromPieces:RookMovers) ifTrue:[^false]. (self checkAttack:{E2. E3. E4. E5. E6. E7. E8} fromPieces:RookMovers) ifTrue:[^false]. (self checkAttack:{A1. A2. A3. A4} fromPieces:RookMovers) ifTrue:[^false]. - (self checkAttack:{G2. F3. E4. D5. C6. B7. A8} fromPieces:BishopMovers) ifTrue:[^false]. (self checkAttack:{F2. E3. D4. C5. B6. A7} fromPieces:BishopMovers) ifTrue:[^false]. (self checkAttack:{E2. D3. C4. B5. A6} fromPieces:BishopMovers) ifTrue:[^false]. (self checkAttack:{D2. C3. B4. A5} fromPieces:BishopMovers) ifTrue:[^false]. (self checkAttack:{F2. G3. H4} fromPieces:BishopMovers) ifTrue:[^false]. (self checkAttack:{G2. H3} fromPieces:BishopMovers) ifTrue:[^false]. (self checkAttack:{H2} fromPieces:BishopMovers) ifTrue:[^false]. + (self checkUnprotectedAttack:{H2. G2. E2. D2. C2. H3. G3. F3. E3. D3} fromPiece:Knight) ifTrue:[^false]. - (self checkUnprotectedAttack:{H2. G2. F2. E2. D2. C2. H3. G3. F3. E3. D3} fromPiece:Knight) ifTrue:[^false]. (self checkUnprotectedAttack:{H2. G2. F2. E2. D2} fromPiece:Pawn) ifTrue:[^false]. (self checkUnprotectedAttack:{G2} fromPiece:King) ifTrue:[^false]. ^true.! Item was changed: ----- Method: ChessMoveGenerator>>canCastleWhiteQueenSide (in category 'support') ----- canCastleWhiteQueenSide (castlingStatus bitAnd: CastlingEnableQueenSide) = 0 ifFalse: [^false]. "Quickly check if all the squares are zero" ((myPieces at:B1) + (myPieces at:C1) + (myPieces at:D1) + (itsPieces at:B1) + (itsPieces at:C1) + (itsPieces at:D1) = 0) ifFalse:[^false]. "Check for castling squares under attack.. See canCastleBlackQueenSide for details" - (self checkAttack:{A2. A3. A4. A5. A6. A7. A8} fromPieces:RookMovers) ifTrue:[^false]. (self checkAttack:{B2. B3. B4. B5. B6. B7. B8} fromPieces:RookMovers) ifTrue:[^false]. (self checkAttack:{C2. C3. C4. C5. C6. C7. C8} fromPieces:RookMovers) ifTrue:[^false]. (self checkAttack:{D2. D3. D4. D5. D6. D7. D8} fromPieces:RookMovers) ifTrue:[^false]. (self checkAttack:{E2. E3. E4. E5. E6. E7. E8} fromPieces:RookMovers) ifTrue:[^false]. (self checkAttack:{F1. G1. H1} fromPieces:RookMovers) ifTrue:[^false]. - (self checkAttack:{B2. C3. D4. E5. F6. G7. H8} fromPieces:BishopMovers) ifTrue:[^false]. (self checkAttack:{C2. D3. E4. F5. G6. H7} fromPieces:BishopMovers) ifTrue:[^false]. (self checkAttack:{D2. E3. F4. G5. H6} fromPieces:BishopMovers) ifTrue:[^false]. (self checkAttack:{E2. F3. G4. H5} fromPieces:BishopMovers) ifTrue:[^false]. (self checkAttack:{F2. G3. H4} fromPieces:BishopMovers) ifTrue:[^false]. (self checkAttack:{A2} fromPieces:BishopMovers) ifTrue:[^false]. (self checkAttack:{B2. A3} fromPieces:BishopMovers) ifTrue:[^false]. (self checkAttack:{C2. B3. A4} fromPieces:BishopMovers) ifTrue:[^false]. (self checkAttack:{D2. C3. B4. A5} fromPieces:BishopMovers) ifTrue:[^false]. (self checkUnprotectedAttack:{A2. B2. C2. D2. E2. F2. G2. A3. B3. C3. D3. E3. F3} fromPiece:Knight) ifTrue:[^false]. (self checkUnprotectedAttack:{A2. B2. C2. D2. E2. F2} fromPiece:Pawn) ifTrue:[^false]. (self checkUnprotectedAttack:{B2. C2} fromPiece:King) ifTrue:[^false]. ^true.! Item was added: + ChessPieceMorph subclass: #ChessPieceMorphWC + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Etoys-Squeakland-Morphic-Games-Chess960'! + + !ChessPieceMorphWC commentStamp: 'spfa 5/31/2020 10:36' prior: 0! + ChessPieceMorphWC class side provides scalable images from Wikimedia Commons! Item was added: + ----- Method: ChessPieceMorphWC class>>pieceExtent (in category 'forms library') ----- + pieceExtent + + ^ 314 @ 302! Item was added: + ----- Method: ChessPieceMorphWC class>>pieces (in category 'forms library') ----- (excessive size, no diff calculated) Item was added: + ----- Method: ChessPieceMorphWC class>>piecesWithExtent: (in category 'forms library') ----- + piecesWithExtent: aPoint + + | form dict ng og pg i ib iw | + + form := self pieces. + dict := Dictionary new. + ng := #( whiteKing blackKing whiteQueen blackQueen whiteBishop blackBishop whiteKnight blackKnight whiteRook blackRook whitePawn blackPawn). + + og := #(55 55 10 10 0 0 0 0 0 0 0 0). + pg := #(0 0 0 0 20 20 50 50 90 90 120 120). + + i := 0. + 0 to: 5 do: [:n | + ib := (i := i + 1) * 2 - 1. + iw := i * 2. + dict at: (ng at: ib) + put: ((form contentsOfArea: (315 * n + (pg at: ib) @0 + corner: 315 * n + 314 - (og at: ib) @ 302)) + scaledToSize: aPoint). + dict at: (ng at: iw) + put: ((form contentsOfArea: (315 * n + (pg at: iw) @327 + corner: 315 * n + 314 - (og at: iw) @ 629)) + scaledToSize: aPoint)]. + + ^ dict! Item was added: + ----- Method: ChessPieceMorphWC class>>piecesWithHeight: (in category 'forms library') ----- + piecesWithHeight: anInteger + + ^ self piecesWithExtent: self pieceExtent x * anInteger / self pieceExtent y @ anInteger! Item was changed: ----- Method: ChessPlayer>>applyEnpassantMove: (in category 'moving') ----- applyEnpassantMove: move + | capturedSquare | + capturedSquare := move destinationSquare - (self isWhitePlayer ifTrue:[8] ifFalse:[-8]). + opponent removePiece: move capturedPiece at: capturedSquare. + self userAgent ifNotNil:[(self userAgent atSquare: capturedSquare) removeAllMorphs]. - opponent removePiece: move capturedPiece at: move destinationSquare - - (self isWhitePlayer ifTrue:[8] ifFalse:[-8]). ^self movePiece: move movingPiece from: move sourceSquare to: move destinationSquare! Item was changed: ----- Method: ChessPlayer>>evaluateMaterial (in category 'evaluation') ----- evaluateMaterial "Compute the board's material balance, from the point of view of the side player. This is an exact clone of the eval function in CHESS 4.5" + | total diff value pawns | - | total diff value | self materialValue = opponent materialValue ifTrue:[^0]. "both sides are equal" total := self materialValue + opponent materialValue. diff := self materialValue - opponent materialValue. + + pawns := numPawns. + pawns < 0 ifTrue: ["happens - a bug somewhere" pawns := 0]. + value := (2400 min: diff) + + ((diff * (12000 - total) * pawns) // (6400 * (pawns + 1))). - ((diff * (12000 - total) * self numPawns) // (6400 * (self numPawns + 1))). ^value! Item was added: + ----- Method: ChessPlayer>>initialLeftRookSquare (in category 'configuration') ----- + initialLeftRookSquare + + ^ self isWhitePlayer ifTrue: [A1] ifFalse: [A8]! Item was added: + ----- Method: ChessPlayer>>initialRightRookSquare (in category 'configuration') ----- + initialRightRookSquare + + ^ self isWhitePlayer ifTrue: [H1] ifFalse: [H8]! Item was changed: ----- Method: ChessPlayer>>isValidMoveFrom:to: (in category 'testing') ----- isValidMoveFrom: sourceSquare to: destSquare | move | move := (self findValidMovesAt: sourceSquare) + detect:[:any| (any triggerSquareIn: board) = destSquare] ifNone:[nil]. - detect:[:any| any destinationSquare = destSquare] ifNone:[nil]. ^move notNil! Item was changed: ----- Method: ChessPlayer>>removePiece:at: (in category 'adding/removing') ----- removePiece: piece at: square + + (pieces at: square) = piece ifFalse: ["fix" + "Happens at time - some moves have a capturedPiece absent from the board" + ^self]. + pieces at: square put: 0. materialValue := materialValue - (PieceValues at: piece). positionalValue := positionalValue - ((PieceCenterScores at: piece) at: square). piece = Pawn ifTrue:[numPawns := numPawns - 1]. board updateHash: piece at: square from: self. + self userAgent ifNotNil:[self userAgent removedPiece: piece at: square]. + ! - self userAgent ifNotNil:[self userAgent removedPiece: piece at: square].! Item was changed: ----- Method: ChessPlayerAI>>statusString (in category 'accessing') ----- statusString | av count | ^String streamContents:[:s| (myMove == #none or:[myMove == nil]) ifFalse:[ + s print: myMove value / 100.0; space. - s print: myMove value * 0.01; space. ]. av := bestVariation. count := av at: 1. count > 0 ifFalse:[ av := activeVariation. count := av at: 1]. count > 0 ifFalse:[ s nextPutAll:'***'. av := variations at: 1. count := av at: 1. count > 3 ifTrue:[count := 3]]. 2 to: count + 1 do:[:index| s nextPutAll: (ChessMove decodeFrom: (av at: index)) moveString. s space]. s nextPut:$[. s print: nodesVisited. " s nextPut:$|. s print: ttHits. s nextPut: $|. s print: alphaBetaCuts. " s nextPut:$]. ].!

1 0

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

03 Jun '20

Marcel Taeumel uploaded a new version of FFI-Pools to project FFI: http://source.squeak.org/FFI/FFI-Pools-mt.19.mcz ==================== Summary ==================== Name: FFI-Pools-mt.19 Author: mt Time: 2 June 2020, 8:17:16.425853 pm UUID: b602902a-6f8f-9549-adc7-d0cd5313cbf7 Ancestors: FFI-Pools-mt.18 Hmpf. Having "FFI-Kernel" and "FFI-Pools" in two separate packages is really annoying. ;-) =============== Diff against FFI-Pools-mt.18 =============== Item was changed: ----- Method: ExternalPoolReadWriter class>>initialize (in category 'class initialization') ----- initialize + "self initializeAtomicTypesExtra."! - self initializeAtomicTypesExtra.!

3 5

FFI | Squeak's Integer to C 'long' or 'long long'
by Marcel Taeumel 02 Jun '20

02 Jun '20

Hi, there! Here is a question of consistency. :-) In the definition of external structures, we write 'long' or 'long long'. In the definition of external pools, we write #Integer. The latter is automatically converted into a "(long long)" cast for printf. What is the better approach? I think it would be better to also write 'long' or 'long long' when defining external pools: <ffiVariable: MY_CONSTANT type: 'long long'> instead of <ffiVariable: MY_CONSTANT type: #LargePositiveInteger> Would make it easier to define platform-specific differences. Best, Marcel

2 3

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

02 Jun '20

Marcel Taeumel uploaded a new version of FFI-Pools to project FFI: http://source.squeak.org/FFI/FFI-Pools-mt.18.mcz ==================== Summary ==================== Name: FFI-Pools-mt.18 Author: mt Time: 2 June 2020, 8:12:17.275821 pm UUID: 48471fb1-0906-ef4a-b9bf-4077c512f814 Ancestors: FFI-Pools-mt.17 Next iteration on external-pool machinery. Please read the class comment of ExternalPool to get started. (I assumed no backwards compatiblility issues since external (shared) pools are a very new feature in Squeak FFI. Apologies if I was mistaken. In that case, update scripts and information will follow asap. Please speak up then :-) =============== Diff against FFI-Pools-mt.17 =============== Item was changed: SystemOrganization addCategory: #'FFI-Pools'! + SystemOrganization addCategory: #'FFI-Pools-Support'! Item was removed: - ----- Method: Boolean class>>ffiExternalSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- - ffiExternalSharedPoolGenerateOutputCodeFor: aVariableName with: aProgramGenerator - aProgramGenerator emitBooleanOutputCodeFor: aVariableName! Item was removed: - ----- Method: Character class>>ffiExternalSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- - ffiExternalSharedPoolGenerateOutputCodeFor: aVariableName with: aProgramGenerator - aProgramGenerator emitCharacterOutputCodeFor: aVariableName! Item was removed: - ----- Method: Class>>asFFIExternalSharedPoolType (in category '*FFI-Pools') ----- - asFFIExternalSharedPoolType - ^ self! Item was added: + SharedPool subclass: #ExternalPool + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Pools'! + ExternalPool class + instanceVariableNames: 'lastDefinition lastPlatform'! + + !ExternalPool commentStamp: 'mt 6/2/2020 18:34' prior: 0! + This is a base class for external pools, which hold external constants, typically required for communicating with external libraries through FFI. Its class side offers valuable entry points for automatically writing pool data from the platform to a portable storage (i.e., #writePoolData) and for automatically reading that pool data from any storage into the pool (i.e., #readPoolData). Once the external pool has up-to-date values, its pool variables can be referenced in FFI calls. Note that a platform change, detected on image start-up, may require to read pool data again to update the pool with values that fit the current platform. + + (For an in-depth explanation of how writing and reading pool data works, refer to the class comment of ExternalPoolReadWriter.) + + + 1. THE CHALLENGE OF PLATFORM-SPECIFIC CONSTANTS + + While authors of packages bridging to the external world are free to collect and manage external constants manually, Squeak's FFI provides a machinery for external (shared) pools to automate this workflow. + + Constants, which are typically derived at C compile time when defining static fields or pre-processing macros, can vary between platforms. First, not all external libraries (and thus header files) have to be present on all platforms. Think of talking to native Linux, macOS, or Windows libraries. Second, even if a library is cross-platform per se, think of #ifdef or platform-specific header files, which could then yield different pool data when collected on different platforms. + + Consequently, it is mandatory that authors of pool definitions add hints about the desired target platform. Those hints can range from very broad (e.g., name = 'Win32' or wordSize = 4) to very narrow (e.g., name = 'Win32' and osVersion = '10.0' and subtype = 'IX86' and wordSize = 4). If a hint is too broad, the wrong pool data might be loaded into a pool because definition matching is automated on system startup. If a hint is too narrow, no pool data might be loaded into a pool -- even if perfectly valid values exist in an accessible pool-data storage. + + + 2. POOL DEFINITIONS + + External pools are defined in the pool's class-side methods using a set of dedicated pragmas. When writing and reading pool data, the pragmas used in those pool-definnition methods configure almost the entire machinery. We will now explain the most important pragmas; you should explore all subclasses of ExternalPool in your image and look at their class sides to find more examples. Also look at the 'pragmas' protocol in ExternalPoolDefinition to get a list of all supported pragmas in pool definitions. + + Here is a minimal example of a pool definition: + + MyExternalPool class >> #unixExample + <ffiExteralPool> + <ffiPlatformName: 'unix'> + <ffiCHeaders: #('<fcntl.h>')> + <ffiVariable: #S_IRUSR type: 'long' convertTo: #Integer> + <ffiVariable: #S_IWUSR type: 'long'> "auto-convert to #Integer" + <ffiVariable: #S_IRGRP> "auto-serialize from 'long' to #Integer" + <ffiVariable: #S_IROTH type: nil> "ignore/skip variable" + ^ self poolDefinition + + The definition above is limited to Unix-based platforms. If points to the 'fcntl.h' header file to be found in the platforms current environment (see notes about compilation in ExternalPoolReadWriter). Pool variables can be defined with varying specificity. The most precise specification includes (1) name of variable (here: #S_IRUSR), (2) atomic type known in Squeak's FFI (here: 'long'), and (3) the desired class of the Smalltalk object in the pool (here: #Integer). + + As you can see, there are shortcuts for common cases, which are C macros expanding to integer numbers, which translates to 'long' in Squeak FFI. Here are more shortcuts: + + <ffiVariable: #M_PI type: 'float' convertTo: #Float> + <ffiVariable: #M_PI type: 'float'> + + <ffiVariable: #M_PI_DBL type: 'double' convertTo: #Float> + <ffiVariable: #M_PI_DBL type: 'double'> + + <ffiVariable: #SOME_LABEL type: 'char*' convertTo: #String> + <ffiVariable: #SOME_LABEL type: 'char*'> + + You may wonder whether this dualism is not necessary. It is not. Take a look at the following examples: + + <ffiVariable: #SOME_CONSTANT type: 'long' convertTo: #Boolean> + <ffiVariable: #SOME_CONSTANT type: 'long' convertTo: #Number> + + <ffiVariable: #SOME_CONSTANT type: 'char' convertTo: #Character> + <ffiVariable: #SOME_CONSTANT type: 'char' convertTo: #Number> + + <ffiVariable: #SOME_CONSTANT type: 'char*' convertTo: #ExternalAddress> + <ffiVariable: #SOME_CONSTANT type: 'int*' convertTo: #ExternalAddress> + + What about that "^ self poolDefinition"? While this is not mandatory for the machinery around external pools to work, it enables a neat debugging facility: + + MyExternalPool unixEample explore. + MyExternalPool unixEample writePoolData. + MyExternalPool unixEample readPoolData. + + Especially if you, being an author of a pool definnition, are not yet so sure about the platform restrictions and hence about that <ffiPlatformName: ... osVersion: ... ...> pragma. + + (For more information about pool definitions, refer to the class comment of ExternalPoolDefinition.) + + + 3. THE MEDIATOR: POOL DATA STORAGE + + We define 'pool data' as an external pool's contents in serialized form. Such pool data is stored at the end of the writing phase (aka. development time) to then be fetched from that storage at the beginning of the reading phase (aka. deployment time). Recall that pool-data reading happens, for example, on image startup if a platform change is detected (see FFIPlatformDescription class >> #startUp:). + + Pool-data storage is dead simple. Pool data is typically made of human-readable ASCII characters, which can easily be stored in files, Smalltalk strings, or any (external) database capable of handling text. Binary formats are possible, yet not present at the time of writing this comment. + + Pool-data storage is the handshake between development time and deployment time, or mediator if you will. Platform constants got encoded as pool data and stored somewhere to be found later. During deployment, you just need to know where to look for. That's where pool definitions come into play. Definitions encode the read-writer and preferred storage to (1) locate and fetch pool data under some identifier and (2) interpret the pool data, which creates structured Smalltalk objects, and (3) finally load the pools contents. + + While there are defaults for this entire mechanism (ExternalPoolDefinition class >> #defaultPoolReadWriterClass and #defaultPoolDataStorage), the following two pragmas can be used in a pool definition to override those defaults: + + <ffiPoolReadWriter: ExternalPoolST1ReadWriter> + <ffiPoolDataStorage: #file> + + If you want to learn more about the available read-writers, refer to the class comment of ExternalPoolReadWriter and its subclasses. Note that not all read-writers may be compatible will all kinds of storage strategies, especially if a serialization form can exploit a database's native format. For example, storing Smalltalk source code in an actual Smalltalk method (i.e., #methodSource). :-) Here are the available storage strategies at the time of writing: + + <ffiPoolDataStorage: #file> + <ffiPoolDataStorage: #methodString> + <ffiPoolDataStorage: #methodSource> + <ffiPoolDataStorage: #methodSourceCompact> + + For further details, please refer to the 'pool data storage' protocol in ExternalPoolReadWriter. + + + 4. WHAT DO YOU WANT TO DO? :-) + + What follows is further advice depending on what you want to do next. + + + 4.1. YOU ARE DEVELOPING AN EXTERNAL POOL + + So, we assume that your definitions looks like this: + + MyExternalPool class >> #myDefinition + <ffiExternalPool> + "..." + ^ self poolDefinition + + You want to explore the pool definition your are developing: + + MyExternalPool myDefinition explore. + + You want to explore the pool definition that will be used when writing or reading pool data: + + MyExternalPool preferredResolvedDefinition explore. + MyExternalPool compatibleResolvedDefinitions explore. + + You want to use a pool definition to write pool data to the configured storage and also read from it? + + MyExternalPool myDefinition writePoolData. + MyExternalPool myDefinition readPoolData. + + You want your pool data to appear side-by-side with the pool definition, yet it does not happen? Try this: + + MyExternalPool myDefinition writePoolDataTo: #methodSource. + MyExternalPool myDefinition readPoolDataFrom: #methodSource. + + You want to take a look at the C program that will be generated from your pool definition? Ha!! You are ready to read and understand ExternalPoolReadWriter!! :-) But here is a snippet anyway: + + MyExternalPool myDefinition previewProgramSource. + MyExternalPool myDefinition getWriter explore. + MyExternalPool myDefinition getReader explore. + + Have fun!! + + + 4.2. YOU ARE USING A DEPLOYED EXTERNAL POOL + + So, you just want to use a bridge package that is relying on external pools to communicate through FFI. Well, hopefully you have access to a compatible pool definition as well as storage that holds the definitions pool data, so that the pool can be populated with actual objects. + + If you have no access to an external pool's compatible definitions and/or required pool-data storage, you can only hope that the pool has already been populated with compatible values. In that case, your image should not be moved between platforms. You should also avoid aggressively cleaning it up via #cleanUp: because that would discard all values. + + At best, you don't have to do anything but it just works. (TM) ^__^ ... ... ... If you suspect an external pool being wrongly set up, try to figure out the definition that was used as well as the platform the values were collected from: + + MyExternalPool class >> #lastDefinition + MyExternalPool class >> #lastPlatform + + You can also take a look at actual definition and contact the developers: + + (MyExternalPool perform: MyExternalPool lastDefinition) explore. + + Good luck anyway!! :-D + + + 5. FURTHER READING + + Please read -- in this order -- the class comments of: + + - FFIPlatformDescription + - ExternalPoolDefinition + - ExternalPoolReadWriter + + + + ^__^ You made it!! ^__^ + + ================ + == END OF COMMENT == + ================ + ! + ExternalPool class + instanceVariableNames: 'lastDefinition lastPlatform'! Item was added: + ----- Method: ExternalPool class>>allExternalSharedPoolClassesDo: (in category 'support - enumerating') ----- + allExternalSharedPoolClassesDo: aBlock + "avoid #withAllSubclassesDo: to enumerate self first" + self isSkipped + ifFalse: [aBlock value: self]. + self allSubclassesDo: [:each | + each isSkipped + ifFalse: [aBlock value: each]].! Item was added: + ----- Method: ExternalPool class>>at: (in category 'shared pool') ----- + at: varName + "For compatiblility. Maybe move up to SharedPool?" + + ^ (self bindingOf: varName) value! Item was added: + ----- Method: ExternalPool class>>at:put: (in category 'shared pool') ----- + at: varName put: object + "For compatiblility. Maybe move up to SharedPool?" + + (self bindingOf: varName) + ifNil: [self addClassVarName: varName]. + + (self bindingOf: varName) + value: object.! Item was added: + ----- Method: ExternalPool class>>cleanUp: (in category 'shared pool') ----- + cleanUp: aggressive + + aggressive ifTrue: [ + self classPool keysDo: [:variableName | + self at: variableName put: nil]].! Item was added: + ----- Method: ExternalPool class>>compatibleResolvedDefinitions (in category 'support - accessing') ----- + compatibleResolvedDefinitions + + | platform definitions | + platform := FFIPlatformDescription current. + definitions := self compatibleResolvedDefinitionsForPlatform: platform. + (definitions size = 1 and: [definitions first isDefault]) ifTrue: [ + self error: ('No compatible definitions found for this ''{1}'' platform.' format: {platform name})]. + ^ definitions! Item was added: + ----- Method: ExternalPool class>>compatibleResolvedDefinitionsForPlatform: (in category 'support - accessing') ----- + compatibleResolvedDefinitionsForPlatform: aPlatform + + | compatibleResolvedDefinitions | + + compatibleResolvedDefinitions := + (self definitionResolverClass on: self) + resolvedDefinitions select: [:each | + each platform isCompatibleWith: aPlatform]. + + compatibleResolvedDefinitions sort: [:a :b | + a isMorePlatformSpecificThan: b]. + + ^ compatibleResolvedDefinitions! Item was added: + ----- Method: ExternalPool class>>definitionClass (in category 'support - defaults') ----- + definitionClass + ^ ExternalPoolDefinition! Item was added: + ----- Method: ExternalPool class>>definitionResolverClass (in category 'support - defaults') ----- + definitionResolverClass + ^ ExternalPoolDefinitionResolver! Item was added: + ----- Method: ExternalPool class>>definitions (in category 'support - accessing') ----- + definitions + "Answers all *unresolved* definitions for this external pool." + + | definitions | + definitions := OrderedCollection with: (self definitionClass defaultFromPool: self). + + self class methodsDo: [:each | + (self definitionClass fromMethod: each) ifNotNil: [:poolDefinition | + definitions add: poolDefinition]]. + + ^ definitions! Item was added: + ----- Method: ExternalPool class>>error: (in category 'support - errors') ----- + error: aString + ExternalPoolError signal: aString! Item was added: + ----- Method: ExternalPool class>>generateDefinitionForCurrentPlatformNameAndWordSize (in category 'writing - dev tools') ----- + generateDefinitionForCurrentPlatformNameAndWordSize + " + self generateDefinitionForCurrentPlatformNameAndWordSize + + Generates a method with a default definition for the + current platform name and word size." + + | currentPlatform defaultDefinition source | + + currentPlatform := self platformClass current. + defaultDefinition := self definitionClass defaultFromPool: self. + source := String streamContents: [:stream | + stream nextPutAll: + ('definitionFor{1}Bit{2} + <ffiExternalSharedPool> + <ffiCCompiler: ''{3}''> + <ffiCFlags: ''{4}''> + <fiiPlatformName: ''{5}'' wordSize: {6}>' + format: + {currentPlatform wordSize * 8. + (currentPlatform name select: [:each | + each isAlphaNumeric]) capitalized. + defaultDefinition cCompiler. + defaultDefinition cFlags. + currentPlatform name. + currentPlatform wordSize}). + defaultDefinition variablesAndTypes keysAndValuesDo: [:key :value | + stream nextPutAll: + (' + <ffiVariable: #{1} type: #{2}>' + format: {key. value})]]. + + self class + compile: source + classified: #'definitions - generated'.! Item was added: + ----- Method: ExternalPool class>>isSkipped (in category 'testing') ----- + isSkipped + "Subclasses can override this to return true if they're abstract or just + don't support program generation or initialization for some reason" + + ^ self == ExternalPool! Item was added: + ----- Method: ExternalPool class>>lastDefinition (in category 'reading - dev tools') ----- + lastDefinition + "Answers the selector of the definition from where the pool's current values were derived. Note that there is no guarantee that the current (resolved) definition is still comparable. Yet, if you are experiencing troubles with this pool's current values, take a look at the definition you find to explore and adjust it. Also see #lastPlatform." + + ^ lastDefinition! Item was added: + ----- Method: ExternalPool class>>lastDefinition: (in category 'reading - dev tools') ----- + lastDefinition: anIdentifier + lastDefinition := anIdentifier.! Item was added: + ----- Method: ExternalPool class>>lastPlatform (in category 'reading - dev tools') ----- + lastPlatform + "Answers a description for the platform where the pool's current values were collected. If you are experiencing troubles with this pool's current values, use this platform descrption to explore and adjust the pool's definition. Also see #lastDefinition." + + ^ lastPlatform! Item was added: + ----- Method: ExternalPool class>>lastPlatform: (in category 'reading - dev tools') ----- + lastPlatform: aPlatform + lastPlatform := aPlatform! Item was added: + ----- Method: ExternalPool class>>platformChangedFrom:to: (in category 'reading - system startup') ----- + platformChangedFrom: lastPlatform to: currentPlatform + + self readAllPoolData.! Item was added: + ----- Method: ExternalPool class>>platformClass (in category 'support - defaults') ----- + platformClass + ^ FFIPlatformDescription! Item was added: + ----- Method: ExternalPool class>>poolDefinition (in category 'writing - dev tools') ----- + poolDefinition + "For convenience. Put a call to this method as a result of your pool definition method." + + thisContext sender method ifNotNil: [:poolDefinitionMethod | + (self definitionClass fromMethod: poolDefinitionMethod) + ifNotNil: [:poolDefinition | ^ poolDefinition resolve]]. + + self error: 'Sender is no valid pool definition!!'.! Item was added: + ----- Method: ExternalPool class>>preferredResolvedDefinition (in category 'support - accessing') ----- + preferredResolvedDefinition + "Answer the preferred - and already resolved - definition for the current platform. Signal an error if only the pool's default definition would be compatible." + + | platform definition | + platform := FFIPlatformDescription current. + definition := self preferredResolvedDefinitionForPlatform: platform. + definition isDefault ifTrue: [ + self error: ('No compatible definition found for this ''{1}'' platform.' format: {platform name})]. + ^ definition! Item was added: + ----- Method: ExternalPool class>>preferredResolvedDefinitionForPlatform: (in category 'support - accessing') ----- + preferredResolvedDefinitionForPlatform: aPlatform + | compatibleResolvedDefinitions | + + compatibleResolvedDefinitions := self compatibleResolvedDefinitionsForPlatform: aPlatform. + + (compatibleResolvedDefinitions size = 1 + or: [ + compatibleResolvedDefinitions first isMorePlatformSpecificThan: + compatibleResolvedDefinitions second]) + ifFalse: [ + self error: + ('Definition #{1} has the same platform specifiation as #{2}. ', + 'Make one more or less platform-specific than: {3}' + format: + {compatibleResolvedDefinitions first name. + compatibleResolvedDefinitions second name. + compatibleResolvedDefinitions first platform})]. + + ^ compatibleResolvedDefinitions first! Item was added: + ----- Method: ExternalPool class>>readAllPoolData (in category 'reading - pool data') ----- + readAllPoolData + + self allExternalSharedPoolClassesDo: [:externalPool | + externalPool readPoolData].! Item was added: + ----- Method: ExternalPool class>>readPoolData (in category 'reading - pool data') ----- + readPoolData + "If there is more than one compatible definition, just read pool data from the first one that has also its storage accessible. For debugging, put an identifier into #lastDefinition." + + self flag: #refactor. + [ + self compatibleResolvedDefinitions do: [:poolDefinition | + [ + self lastDefinition: nil; lastPlatform: nil. + poolDefinition readPoolData. + self + assert: [self lastDefinition notNil] + description: 'Bad read-writer. No definition set.'; + assert: [self lastPlatform notNil] + description: 'Bad read-writer. No platform set.'. + ^ self + ] ifError: [:err | Transcript showln: '[ExternalPool] Could not read pool data: ', err ]]. + ] ifError: [:err | Transcript showln: '[ExternalPool] Could not collect pool definitions: ', err]. + + Transcript showln: '[ExternalPool] FATAL!! No accessible storage for pool data found for ', self name. + ! Item was added: + ----- Method: ExternalPool class>>writeAllPoolData (in category 'writing - pool data') ----- + writeAllPoolData + + self allExternalSharedPoolClassesDo: [:externalPool | + externalPool writePoolData].! Item was added: + ----- Method: ExternalPool class>>writePoolData (in category 'writing - pool data') ----- + writePoolData + + self preferredResolvedDefinition writePoolData.! Item was added: + Object subclass: #ExternalPoolDefinition + instanceVariableNames: 'name origin inheritsFrom variablesAndTypes platform cFlags cCompiler cHeaders poolReadWriterClass poolDataStorage' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Pools'! + + !ExternalPoolDefinition commentStamp: 'mt 6/2/2020 16:31' prior: 0! + (NOTICE: If you have not yet read the class comment of ExternalPool, please do so before reading further.) + + This class holds pool definitions, which got parsed from the pragma-based descriptions (i.e., <ffiExternalPool>) used in class-side methods of external pools (i.e., subclasses of ExternalPool). Its instances are short-living in general and mostly used during the activity of writing and reading pool data via a pool read-writer. See ExternalPoolReadWriter. + + + 1. RECAP: POOL DEFINITIONS + + Given that there is a method like this: + + MyExternalPool class >> #myDefinition + <ffiExternalPool> + <ffiCHeaders: #('<math.h>' '<limits.h>')> + <ffiVariable: #INT_MAX type: 'long' convertTo: #Integer> + ^ self poolDefinition + + All supported pragmas map to selectors in this class. See the 'pragmas' protocol. Mostly, all literals provided via pragmas will be stored in this class' instances by delegation to plain accessors. You can explore all pragma shortcuts by browsing the available #ffi* methods such as #ffiVariable: and #ffiPlatformName:. + + The easiest way to get a pool definition to explore is by adding "^ self poolDefinition" to the definition method and then just calling that method like this: + + MyExternalPool myDefinition explore. + + Note that this is just a development tool and not required for the machinery around external pools to work properly. + + + 2. DEFINITION INHERITANCE AND VALUE RESOLVING + + Pool definitions can inherit values from another definition by referring to its name in a pragma: + + <ffiInheritsFrom: #base> + + Such inheritance can be used to put platform-specific values in front of cross-platform variable names. You can also mask out variables by overwriting them: + + <ffiPlatformName: 'unix' osVersion: 'my-unix'> + <ffiVariable: #INT_MAX type: nil> "Not there on my platform. Sorry." + + Note that there is only single inheritance. Cycles will be detected when resolving the inheritance path. + + Definition resolving means walking up the inheritance chain and filling the values that have not been already set. There is no elabroate merging algorithm. Just fill the empty values. Consequently, if a more specific definition provides, for example, <ffiCHeaders: #(...)>, any headers from a base definition will be ignored. + + + 3. THE DEFAULT DEFINITION + + There are defaults for any definition's value and an external pool's default definition reifies all those defaults a definition can have. Implicitely, all definitions inherit from the default definition. So, the same rules apply for default values as they do for inheritance (or resolving) as described above. + + There are two important default values: + + ExternalPoolDefinition class >> #defaultPoolReadWriterClass + ... corresponds to the pragma <ffiPoolReadWriter: ...> + ExternalPoolDefinition class >> #defaultPoolDataStorage + ... corresponds to the pragma <ffiPoolDataStorage: ...> + + If you ever decide to change the default storage for pool data, you have to rely on the read-writers reading logic to try out all known storages ... one after another. That's okay. Maybe slow, but okay. + + BUT (!! WARNING !!) if you ever decide to change the default read-writer, pool definitions that omit to mention their typical serialization format will not be able to assist the entire machinery around ExternalPool to interpret (and load) the pool data. Manual intervention would be required. + + Choose your defaults wisely. ^__^ + + + 4. NOTES ON COMPILER FLAGS + + The <ffiCCompiler:>, <ffiCFlags:>, and <ffiCHeaders:> pragmas control compilation. The first two take String arguments, and the third takes an Array of header path Strings. + + You can further configure C compilation for your platform through the "FFI Pools" preferences. + + ! Item was added: + ----- Method: ExternalPoolDefinition class>>defaultCCompiler (in category 'defaults') ----- + defaultCCompiler + ^ ''! Item was added: + ----- Method: ExternalPoolDefinition class>>defaultCFlags (in category 'defaults') ----- + defaultCFlags + ^ ''! Item was added: + ----- Method: ExternalPoolDefinition class>>defaultCHeaders (in category 'defaults') ----- + defaultCHeaders + ^ #()! Item was added: + ----- Method: ExternalPoolDefinition class>>defaultFromPool: (in category 'instance creation') ----- + defaultFromPool: externalPool + | definition | + + (definition := self new) + origin: externalPool; + ffiCCompiler: self defaultCCompiler; + ffiCFlags: self defaultCFlags; + ffiCHeaders: self defaultCHeaders; + platform: self defaultPlatform; + poolReadWriterClass: self defaultPoolReadWriterClass; + poolDataStorage: self defaultPoolDataStorage. + + "Include all the existing variables from the pool so that the author of the pool definition notices if some existing variables shoudl be masked on a certain platform." + externalPool bindingsDo: [:binding | definition ffiVariable: binding key]. + + ^ definition! Item was added: + ----- Method: ExternalPoolDefinition class>>defaultPlatform (in category 'defaults') ----- + defaultPlatform + ^ self platformClass empty! Item was added: + ----- Method: ExternalPoolDefinition class>>defaultPoolDataStorage (in category 'defaults') ----- + defaultPoolDataStorage + "#file, #methodString, #methodSource, #methodSourceCompact, ... See 'pool data storage' protocol in ExternalPoolReadWriter." + + ^ #methodSource! Item was added: + ----- Method: ExternalPoolDefinition class>>defaultPoolReadWriterClass (in category 'defaults') ----- + defaultPoolReadWriterClass + "WARNING!! Changing this value might render the machinery to read pool data void for pool definitions that omit to mention their typical serialization format via <ffiPoolReadWriter: ...>. Consequently, change the default read-writer only if you have access to all important pool definitions. + + See all subclasses of ExternalPoolReadWriter." + + ^ ExternalPoolST1ReadWriter! Item was added: + ----- Method: ExternalPoolDefinition class>>fromMethod: (in category 'instance creation') ----- + fromMethod: aCompiledMethod + | definition | + + (aCompiledMethod pragmaAt: #ffiExternalPool) + ifNil: [^ nil]. + + definition := self name: aCompiledMethod selector. + definition origin: aCompiledMethod methodClass theNonMetaClass. + + "Squeak does not have #pragmasDo:" + aCompiledMethod pragmas do: [:each | + (self whichCategoryIncludesSelector: each keyword) == #'pragmas' + ifTrue: [ + definition + perform: each keyword + withArguments: each arguments]]. + + ^ definition.! Item was added: + ----- Method: ExternalPoolDefinition class>>name: (in category 'instance creation') ----- + name: aSelector + ^ self new name: aSelector! Item was added: + ----- Method: ExternalPoolDefinition class>>platformClass (in category 'defaults') ----- + platformClass + ^ FFIPlatformDescription! Item was added: + ----- Method: ExternalPoolDefinition>>cCompiler (in category 'accessing') ----- + cCompiler + ^ cCompiler ifNil: [cCompiler := '']! Item was added: + ----- Method: ExternalPoolDefinition>>cCompiler: (in category 'accessing') ----- + cCompiler: aStringOrNil + cCompiler := + aStringOrNil + ifNotNil: [aStringOrNil asString]! Item was added: + ----- Method: ExternalPoolDefinition>>cFlags (in category 'accessing') ----- + cFlags + "Note that ${INCLUDE} will be replaced with read-writer's choice of path to keep the definition of <cHeaders: ...> compact across all platforms. This usually the absolute path to Squeak's image file. Note that ${OUTPUT} will be replaced with the read-writer's choice of file path for the compiled C program." + + ^ cFlags ifNil: [cFlags := '']! Item was added: + ----- Method: ExternalPoolDefinition>>cFlags: (in category 'accessing') ----- + cFlags: aStringOrNil + cFlags := + aStringOrNil + ifNotNil: [aStringOrNil asString]! Item was added: + ----- Method: ExternalPoolDefinition>>cHeaders (in category 'accessing') ----- + cHeaders + ^ cHeaders ifNil: [cHeaders := #()]! Item was added: + ----- Method: ExternalPoolDefinition>>cHeaders: (in category 'accessing') ----- + cHeaders: aHeaderPathCollection + cHeaders := + aHeaderPathCollection asArray + select: [:each | each notEmpty] + thenCollect: [:each | | header | + header := each asString. + (header first == $" + or: [header first == $<]) + ifTrue: [header] + ifFalse: ['<', header, '>']]! Item was added: + ----- Method: ExternalPoolDefinition>>cHeadersDo: (in category 'enumerating') ----- + cHeadersDo: aBlock + self cHeaders do: aBlock! Item was added: + ----- Method: ExternalPoolDefinition>>compatibleName: (in category 'compatibility') ----- + compatibleName: variableName + "Ensure that variableName can be used as a name in the external pool. Negotiate between C land and Smalltalk land." + + | compatibleName | + compatibleName := variableName. + + "1) For example, vendor-specific macros might start with underscore, which is not allowed in a class pool." + [compatibleName beginsWith: '_'] whileTrue: [ + compatibleName := compatibleName allButFirst]. + + "2) Static variables typically start with a lowercase letter, which is not allowed in a class pool." + compatibleName := compatibleName first asUppercase asString, compatibleName allButFirst. + + ^ compatibleName! Item was added: + ----- Method: ExternalPoolDefinition>>externalTypeForClassName: (in category 'compatibility') ----- + externalTypeForClassName: aClassName + "For compatiblility only. Try to figure out the external type for a given class name." + + | class | + self deprecated: 'Please use #convertTo: to specify the Smalltalk class. #type: is reserved for C type names.'. + + class := (self environment classNamed: aClassName) ifNil: [ + ExternalPoolError signal: + 'Cannot determine C type for ', aClassName, '; ', + 'no matching Smalltalk class found']. + + class == Boolean ifTrue: [^ ExternalType bool]. + class == Character ifTrue: [^ ExternalType unsignedChar]. + (class includesBehavior: Integer) ifTrue: [ + ^ (class includesBehavior: LargePositiveInteger) + ifFalse: [ExternalType signedLongLong] + ifTrue: [ExternalType unsignedLongLong]]. + (class includesBehavior: Float) ifTrue: [^ ExternalType double]. + (class includesBehavior: String) ifTrue: [^ ExternalType char asPointerType]. + + ExternalPoolError signal: + 'Cannot determine C type for ', aClassName, '; ', + 'no matching atomic type found'.! Item was added: + ----- Method: ExternalPoolDefinition>>ffiCCompiler: (in category 'pragmas') ----- + ffiCCompiler: aString + self cCompiler: aString! Item was added: + ----- Method: ExternalPoolDefinition>>ffiCFlags: (in category 'pragmas') ----- + ffiCFlags: aString + self cFlags: aString! Item was added: + ----- Method: ExternalPoolDefinition>>ffiCHeaders: (in category 'pragmas') ----- + ffiCHeaders: aHeaderPathCollection + self cHeaders: aHeaderPathCollection! Item was added: + ----- Method: ExternalPoolDefinition>>ffiExternalPool (in category 'pragmas') ----- + ffiExternalPool + "this pragma identifies a method as defining an external shared pool"! Item was added: + ----- Method: ExternalPoolDefinition>>ffiInheritsFrom: (in category 'pragmas') ----- + ffiInheritsFrom: aSelector + self inheritsFrom: aSelector! Item was added: + ----- Method: ExternalPoolDefinition>>ffiPlatformName: (in category 'pragmas') ----- + ffiPlatformName: aName + self platform: + (self platformClass name: aName)! Item was added: + ----- Method: ExternalPoolDefinition>>ffiPlatformName:osVersion: (in category 'pragmas') ----- + ffiPlatformName: aName osVersion: anOSVersionString + self platform: + (self platformClass + name: aName + osVersion: anOSVersionString)! Item was added: + ----- Method: ExternalPoolDefinition>>ffiPlatformName:osVersion:subtype: (in category 'pragmas') ----- + ffiPlatformName: aName osVersion: anOSVersionString subtype: aSubtypeString + self platform: + (self platformClass + name: aName + osVersion: anOSVersionString + subtype: aSubtypeString)! Item was added: + ----- Method: ExternalPoolDefinition>>ffiPlatformName:osVersion:subtype:wordSize: (in category 'pragmas') ----- + ffiPlatformName: aName osVersion: anOSVersionString subtype: aSubtypeString wordSize: aWordSize + self platform: + (self platformClass + name: aName + osVersion: anOSVersionString + subtype: aSubtypeString + wordSize: aWordSize)! Item was added: + ----- Method: ExternalPoolDefinition>>ffiPlatformName:wordSize: (in category 'pragmas') ----- + ffiPlatformName: aName wordSize: aWordSize + self platform: + (self platformClass + name: aName + wordSize: aWordSize)! Item was added: + ----- Method: ExternalPoolDefinition>>ffiPoolDataStorage: (in category 'pragmas') ----- + ffiPoolDataStorage: aSymbol + self poolDataStorage: aSymbol! Item was added: + ----- Method: ExternalPoolDefinition>>ffiPoolReadWriter: (in category 'pragmas') ----- + ffiPoolReadWriter: aClassName + self poolReadWriterClass: aClassName! Item was added: + ----- Method: ExternalPoolDefinition>>ffiVariable: (in category 'pragmas') ----- + ffiVariable: aVariableName + "Shortcut. Many libraries' C constants are just 4-byte integers on both 32-bit and 64-bit platforms." + + self flag: #ffiLongVsInt. "Our 'long' is a 4-byte integer." + + self + ffiVariable: aVariableName + type: 'long' + convertTo: #Integer.! Item was added: + ----- Method: ExternalPoolDefinition>>ffiVariable:type: (in category 'pragmas') ----- + ffiVariable: aVariableName type: aVariableTypeName + "Shortcut. Accept any kind of automatically created object for the specified type. Note that this creation happens via the FFIExternalPoolReadWriter." + + self + ffiVariable: aVariableName + type: aVariableTypeName + convertTo: #Object.! Item was added: + ----- 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." + externalType := (ExternalType atomicTypeNamed: (aVariableTypeName findTokens: '*') first withBlanksTrimmed) + ifNotNil: [:atomicType | + targetClassName := aClassName. + aVariableTypeName last = $* + ifTrue: [atomicType asPointerType] + ifFalse: [atomicType]] + 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.! Item was added: + ----- Method: ExternalPoolDefinition>>getReader (in category 'read/write pool data') ----- + getReader + + ^ self poolReadWriterClass onDefinition: self! Item was added: + ----- Method: ExternalPoolDefinition>>getWriter (in category 'read/write pool data') ----- + getWriter + + ^ self poolReadWriterClass onDefinition: self! Item was added: + ----- Method: ExternalPoolDefinition>>inheritFromDefinition: (in category 'resolving') ----- + inheritFromDefinition: aDefinition + self cCompiler + ifEmpty: [self cCompiler: aDefinition cCompiler]. + self cFlags + ifEmpty: [self cFlags: aDefinition cFlags]. + self cHeaders + ifEmpty: [self cHeaders: aDefinition cHeaders]. + self platform + ifNil: [self platform: aDefinition platform]. + self poolReadWriterClass + ifNil: [self poolReadWriterClass: aDefinition poolReadWriterClass]. + self poolDataStorage + ifNil: [self poolDataStorage: aDefinition poolDataStorage]. + + aDefinition variablesAndTypes keysAndValuesDo: [:key :value | + "Avoid inheriting compatible names." + (self variablesAndTypes keys anySatisfy: [:each | (self compatibleName: each) = key]) + ifFalse: [self variablesAndTypesAt: key ifAbsentPut: [value]]].! Item was added: + ----- Method: ExternalPoolDefinition>>inheritsFrom (in category 'accessing') ----- + inheritsFrom + ^ inheritsFrom! Item was added: + ----- Method: ExternalPoolDefinition>>inheritsFrom: (in category 'accessing') ----- + inheritsFrom: aSelectorOrNil + inheritsFrom := + aSelectorOrNil + ifNotNil: [aSelectorOrNil asSymbol]! Item was added: + ----- Method: ExternalPoolDefinition>>isDefault (in category 'testing') ----- + isDefault + ^ self name isNil! Item was added: + ----- Method: ExternalPoolDefinition>>isMorePlatformSpecificThan: (in category 'testing') ----- + isMorePlatformSpecificThan: aDefinition + ^ aDefinition isDefault + or: [self platform isMoreSpecificThan: aDefinition platform]! Item was added: + ----- Method: ExternalPoolDefinition>>name (in category 'accessing') ----- + name + ^ name! Item was added: + ----- Method: ExternalPoolDefinition>>name: (in category 'accessing') ----- + name: aSelectorOrNil + name := + aSelectorOrNil + ifNotNil: [aSelectorOrNil asSymbol]! Item was added: + ----- Method: ExternalPoolDefinition>>origin (in category 'accessing') ----- + origin + + ^ origin! Item was added: + ----- Method: ExternalPoolDefinition>>origin: (in category 'accessing') ----- + origin: anObject + + origin := anObject.! Item was added: + ----- Method: ExternalPoolDefinition>>platform (in category 'accessing') ----- + platform + ^ platform! Item was added: + ----- Method: ExternalPoolDefinition>>platform: (in category 'accessing') ----- + platform: aPlatform + platform := aPlatform! Item was added: + ----- Method: ExternalPoolDefinition>>platformClass (in category 'defaults') ----- + platformClass + ^ self class platformClass! Item was added: + ----- Method: ExternalPoolDefinition>>poolDataStorage (in category 'accessing') ----- + poolDataStorage + ^ poolDataStorage! Item was added: + ----- Method: ExternalPoolDefinition>>poolDataStorage: (in category 'accessing') ----- + poolDataStorage: aSymbol + poolDataStorage := aSymbol.! Item was added: + ----- Method: ExternalPoolDefinition>>poolReadWriterClass (in category 'accessing') ----- + poolReadWriterClass + ^ poolReadWriterClass! Item was added: + ----- Method: ExternalPoolDefinition>>poolReadWriterClass: (in category 'accessing') ----- + poolReadWriterClass: aClassOrClassName + poolReadWriterClass := + aClassOrClassName isBehavior + ifTrue: [aClassOrClassName] + ifFalse: [self class environment at: aClassOrClassName asSymbol]! Item was added: + ----- Method: ExternalPoolDefinition>>previewProgramSource (in category 'read/write pool data') ----- + previewProgramSource + "For conveniently testing and debugging only." + + self getWriter generatedProgramSource edit.! Item was added: + ----- Method: ExternalPoolDefinition>>printOn: (in category 'printing') ----- + printOn: aStream + super printOn: aStream. + + aStream nextPut: $(. + self isDefault + ifTrue: [aStream nextPutAll: 'default'] + ifFalse: [aStream print: self name]. + aStream nextPut: $).! Item was added: + ----- Method: ExternalPoolDefinition>>readPoolData (in category 'read/write pool data') ----- + readPoolData + + self getReader readPoolData.! Item was added: + ----- Method: ExternalPoolDefinition>>readPoolDataFrom: (in category 'read/write pool data') ----- + readPoolDataFrom: storage + "Override the definitions storage strategy. Try the given one first." + + | priorStorage | + priorStorage := self poolDataStorage. + + [self poolDataStorage: storage. self readPoolData] + ensure: [self poolDataStorage: priorStorage].! Item was added: + ----- Method: ExternalPoolDefinition>>resolve (in category 'resolving') ----- + resolve + "For convenience, testing, and debugging purposes. Usually, you should call #preferredResolvedDefinition on your external pool." + + | externalPool | + externalPool := self origin. + (externalPool definitionResolverClass onDefinition: self) + resolveDefinition: self.! Item was added: + ----- Method: ExternalPoolDefinition>>variablesAndTypes (in category 'accessing') ----- + variablesAndTypes + ^ variablesAndTypes ifNil: [variablesAndTypes := Dictionary new]! Item was added: + ----- Method: ExternalPoolDefinition>>variablesAndTypes: (in category 'accessing') ----- + variablesAndTypes: anAssociationCollection + variablesAndTypes := Dictionary new. + anAssociationCollection associationsDo: [:each | + self + variablesAndTypesAt: each key + put: each].! Item was added: + ----- Method: ExternalPoolDefinition>>variablesAndTypesAt: (in category 'accessing') ----- + variablesAndTypesAt: aVariableName + ^ self + variablesAndTypesAt: aVariableName + ifAbsent: [nil]! Item was added: + ----- Method: ExternalPoolDefinition>>variablesAndTypesAt:ifAbsent: (in category 'accessing') ----- + variablesAndTypesAt: aVariableName ifAbsent: aBlock + ^ self variablesAndTypes + at: aVariableName asSymbol + ifAbsent: aBlock! Item was added: + ----- Method: ExternalPoolDefinition>>variablesAndTypesAt:ifAbsentPut: (in category 'accessing') ----- + variablesAndTypesAt: aVariableName ifAbsentPut: aBlock + ^ self + variablesAndTypesAt: aVariableName + ifAbsent: [ + self + variablesAndTypesAt: aVariableName + put: aBlock value]! Item was added: + ----- Method: ExternalPoolDefinition>>variablesAndTypesAt:put: (in category 'accessing') ----- + variablesAndTypesAt: aVariableName put: externalTypeToClassOrNil + ^ self variablesAndTypes + at: aVariableName asSymbol + put: externalTypeToClassOrNil! Item was added: + ----- Method: ExternalPoolDefinition>>variablesAndTypesDo: (in category 'enumerating') ----- + variablesAndTypesDo: workBlock + + self + variablesAndTypesDo: workBlock + separatedBy: [].! Item was added: + ----- Method: ExternalPoolDefinition>>variablesAndTypesDo:separatedBy: (in category 'enumerating') ----- + variablesAndTypesDo: workBlock separatedBy: separatorBlock + "Skip the variables whose type is nil. Offer callers to access a Smalltalk-compatible name for the variable right here. Read-writers can always do that conversion later, e.g., during interpretation or loading phase of the pool data." + + | beforeFirst | + beforeFirst := true. + self variablesAndTypes keysAndValuesDo: [:key :value | + value ifNotNil: [ + beforeFirst + ifTrue: [beforeFirst := false] + ifFalse: [separatorBlock value]. + workBlock + cull: key + cull: value + cull: (self compatibleName: key)]].! Item was added: + ----- Method: ExternalPoolDefinition>>writePoolData (in category 'read/write pool data') ----- + writePoolData + + self getWriter writePoolData.! Item was added: + ----- Method: ExternalPoolDefinition>>writePoolDataTo: (in category 'read/write pool data') ----- + writePoolDataTo: storage + "Override the definitions storage strategy." + + | priorStorage | + priorStorage := self poolDataStorage. + + [self poolDataStorage: storage. self writePoolData] + ensure: [self poolDataStorage: priorStorage].! Item was added: + Object subclass: #ExternalPoolDefinitionResolver + instanceVariableNames: 'class definitions defaultDefinition definitionsByName unresolvedDefinitions visitedDefinitions' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Pools-Support'! + + !ExternalPoolDefinitionResolver commentStamp: 'mt 6/2/2020 18:40' prior: 0! + This class resolves pool definitions to make the pragma <ffiInheritsFrom: ...> work. If you have not yet read the class comment of ExternalPoolDefinition, please do so to learn more about external pools.! Item was added: + ----- Method: ExternalPoolDefinitionResolver class>>class:definitions: (in category 'instance creation') ----- + class: aClass definitions: aDefinitionCollection + ^ self new + setClass: aClass + definitions: aDefinitionCollection! Item was added: + ----- Method: ExternalPoolDefinitionResolver class>>on: (in category 'instance creation') ----- + on: externalPool + + ^ self new setPool: externalPool! Item was added: + ----- Method: ExternalPoolDefinitionResolver class>>onDefinition: (in category 'instance creation') ----- + onDefinition: externalPoolDefinition + + ^ self new setPoolDefinition: externalPoolDefinition + ! Item was added: + ----- Method: ExternalPoolDefinitionResolver>>error: (in category 'private') ----- + error: aString + ExternalPoolError signal: aString! Item was added: + ----- Method: ExternalPoolDefinitionResolver>>errorLoopInDefinitions (in category 'private') ----- + errorLoopInDefinitions + self error: 'Class ', class name asString, ' has a loop in its definitions'! Item was added: + ----- Method: ExternalPoolDefinitionResolver>>errorUnknownReferenceInDefinition: (in category 'private') ----- + errorUnknownReferenceInDefinition: aDefinition + self error: + ('Unknown reference to definition #{1} in definition #{2} from class {3}' + format: {aDefinition inheritsFrom. aDefinition name. class name})! Item was added: + ----- Method: ExternalPoolDefinitionResolver>>resolveDefinition: (in category 'private') ----- + resolveDefinition: aDefinition + aDefinition inheritsFrom + ifNil: [aDefinition inheritFromDefinition: defaultDefinition] + ifNotNil: [:inheritsFrom | | inheritedDefinition | + inheritedDefinition := + definitionsByName + at: inheritsFrom + ifAbsent: [self errorUnknownReferenceInDefinition: aDefinition]. + + (visitedDefinitions includes: inheritedDefinition) + ifTrue: [self errorLoopInDefinitions]. + visitedDefinitions add: inheritedDefinition. + + (unresolvedDefinitions includes: inheritedDefinition) + ifTrue: [self resolveDefinition: inheritedDefinition]. + + aDefinition inheritFromDefinition: inheritedDefinition]. + + unresolvedDefinitions remove: aDefinition.! Item was added: + ----- Method: ExternalPoolDefinitionResolver>>resolvedDefinitions (in category 'accessing') ----- + resolvedDefinitions + [unresolvedDefinitions isEmpty] + whileFalse: [| definition | + definition := unresolvedDefinitions anyOne. + visitedDefinitions := Set with: definition. + self resolveDefinition: definition]. + + ^ definitions.! Item was added: + ----- Method: ExternalPoolDefinitionResolver>>setClass:definitions: (in category 'initialization') ----- + setClass: aClass definitions: aDefinitionCollection + class := aClass. + definitions := aDefinitionCollection. + definitionsByName := Dictionary new. + unresolvedDefinitions := Set new. + definitions do: [:each | + each isDefault + ifTrue: [defaultDefinition := each] + ifFalse: [ + definitionsByName + at: each name + put: each. + unresolvedDefinitions add: each]].! Item was added: + ----- Method: ExternalPoolDefinitionResolver>>setPool: (in category 'initialization') ----- + setPool: externalPool + + self + setClass: externalPool + definitions: externalPool definitions.! Item was added: + ----- Method: ExternalPoolDefinitionResolver>>setPoolDefinition: (in category 'initialization') ----- + setPoolDefinition: anExternalPoolDefinition + "Convenient way to resolve a single definition. For debugging purposes." + + self setPool: anExternalPoolDefinition origin. + + "Reconfigure the resolver to work with the given definition, too." + {definitions. unresolvedDefinitions} do: [:cache | + cache removeAllSuchThat: [:def | def name = anExternalPoolDefinition name]. + cache add: anExternalPoolDefinition]. + definitionsByName + at: anExternalPoolDefinition name + put: anExternalPoolDefinition. + + "Prepare for directly calling #resolveDefinition:." + visitedDefinitions := Set with: anExternalPoolDefinition.! Item was added: + Error subclass: #ExternalPoolError + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Pools'! + + !ExternalPoolError commentStamp: 'monty 4/3/2018 07:25' prior: 0! + This is an exception class for all FFIExternalSharedPool errors. Any new exception classes added will be subclasses of this one.! Item was added: + ExternalPoolReadWriter subclass: #ExternalPoolJSONReadWriter + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Pools'! + + !ExternalPoolJSONReadWriter commentStamp: 'mt 6/2/2020 18:55' prior: 0! + I depend on JSON support for serializing and interpreting pool data. See #ensureParsingSupport. Well, one could reduce that support to be required only during interpretation, that is, the reading phase. See #nextPutPlatform: and #nextPutObject:. + + Here is an example of my serialization format: + + [ + {"wordSize":4,"name":"Win32","subtype":"IX86","osVersion":"10.0"}, + { + "M_PI":"3.141592741012573242188e+00", + "SDL_WINDOW_FULLSCREEN":1, + "AUDIO_S32LSB":32800, + "SDL_WINDOW_SHOWN":4, + "M_E":"2.718281745910644531250e+00", + "AUDIO_U16":16 + } + ] + ! Item was added: + ----- Method: ExternalPoolJSONReadWriter>>ensureParsingSupport (in category 'initialization') ----- + ensureParsingSupport + + (self environment classNamed: #Json) ifNil: [ + Installer ss project: 'JSON'; install: 'JSON'. + (self environment classNamed: #Json) ifNil: [ + self notify: 'JSON support could not be loaded.']]! Item was added: + ----- Method: ExternalPoolJSONReadWriter>>interpretPoolData (in category 'reading - fetch/interpret/clear/load') ----- + interpretPoolData + + 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)]].! Item was added: + ----- Method: ExternalPoolJSONReadWriter>>loadPoolData (in category 'reading - fetch/interpret/clear/load') ----- + loadPoolData + + super loadPoolData. + + externalPool lastPlatform: poolData first. + + poolData second keysAndValuesDo: [:name :value | + "Be sure to convert the name into something compatible with Smalltalk." + externalPool at: (poolDefinition compatibleName: name) put: value].! Item was added: + ----- Method: ExternalPoolJSONReadWriter>>nextPutDefinition: (in category 'writing - serialization') ----- + nextPutDefinition: aPoolDefinition + + self + nextPut: $[; + nextPutLineEnding. + + self + tab; + nextPutPlatform: self platform; + nextPut: $,; + nextPutLineEnding. + + self + tab; + nextPut: ${; + nextPutLineEnding. + + aPoolDefinition + variablesAndTypesDo: [:cVariable :type | + self + tab; tab; + nextPutAll: ('"{1}":' format: {cVariable}); + nextPutVariable: cVariable + type: type key + convertTo: type value] + separatedBy: [ + self + nextPut: $,; + nextPutLineEnding]. + + self + nextPutLineEnding; + tab; + nextPut: $}; + nextPutLineEnding. + + self + nextPut: $]; + nextPutLineEnding.! Item was added: + ----- Method: ExternalPoolJSONReadWriter>>nextPutFloatVariable:from: (in category 'writing - serialize platform constants') ----- + nextPutFloatVariable: aName from: anExternalType + "JSON has no support for NaN or +/- Infinity. Be save and serialize strings for floats. Parse later when interpreting the pool data." + + self nextPut: $". + super nextPutFloatVariable: aName from: anExternalType. + self nextPut: $".! Item was added: + ----- Method: ExternalPoolJSONReadWriter>>nextPutObject: (in category 'writing - serialize image constants') ----- + nextPutObject: anObject + "Unpack the instVars of the given object and store them in a map. This will only work for simple objects and depends on the level of JSON support in the system." + + self nextPutAll: (Dictionary newFrom: (anObject class instVarNames collect: [:instVarName | + instVarName -> (anObject instVarNamed: instVarName)])) asJsonString.! Item was added: + ----- Method: ExternalPoolJSONReadWriter>>nextPutPlatform: (in category 'writing - serialization') ----- + nextPutPlatform: aPlatform + + self nextPutObject: aPlatform.! Item was added: + ----- Method: ExternalPoolJSONReadWriter>>nextPutPointerVariable:from: (in category 'writing - serialize platform constants') ----- + nextPutPointerVariable: aName from: anExternalType + "Pointer addresses are usually hexadecimal outputs. Parse later when interpreting the pool data." + + self nextPutStringVariable: aName from: anExternalType.! Item was added: + ----- Method: ExternalPoolJSONReadWriter>>nextPutStringVariable:from: (in category 'writing - serialize platform constants') ----- + nextPutStringVariable: aName from: anExternalType + + self nextPut: $". + super nextPutStringVariable: aName from: anExternalType. + self nextPut: $".! Item was added: + ----- Method: ExternalPoolJSONReadWriter>>storageFileName (in category 'pool data storage - configuration') ----- + storageFileName + "Since we output JSON, which is compatible with JavaScript, put it in a .js file." + + ^ self id, '.js'! Item was added: + ExternalPoolReadWriter subclass: #ExternalPoolLinesReadWriter + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Pools'! + + !ExternalPoolLinesReadWriter commentStamp: 'mt 6/2/2020 18:51' prior: 0! + I serialize pool definnitions as simple lines, mostly as emitted by C printf(), whose format placeholders are configured per atomic type. See #cFormatPlaceholderFor:. + + You can use me as a base class for developing a new read-writer that needs heavy-lifting during pool-data interpretation. See the methods in 'interpret platform constants' protocol. Note that "heavy lifting" refers to the creation of Smalltalk objects. For the fun of it, try comparing me to ExternalPoolSmalltalkReadWriter. + + Here is an example of my serialization format: + + Win32 + 10.0 + IX86 + 4 + M_PI + 3.141592741012573242188e+00 + SDL_WINDOW_FULLSCREEN + 1 + AUDIO_S32LSB + 32800 + SDL_WINDOW_SHOWN + 4 + M_E + 3.718281745910644531250e+00 + AUDIO_U16 + 16 + ! Item was added: + ----- Method: ExternalPoolLinesReadWriter>>ensureParsingSupport (in category 'initialization') ----- + ensureParsingSupport + "I do all the parsing myself. At least up to the point I can rely on the Smalltalk parser/compiler."! Item was added: + ----- Method: ExternalPoolLinesReadWriter>>interpretPoolData (in category 'reading - fetch/interpret/clear/load') ----- + interpretPoolData + "We do here, what, for example, ExternalPoolST1ReadWriter did already during serialization in the writing phase." + + | lines | + lines := poolData lines. + poolData := OrderedCollection new. + + poolData add: (FFIPlatformDescription + name: lines first + osVersion: lines second + subtype: lines third + wordSize: lines fourth asNumber). + + poolData add: Dictionary new. + + (lines allButFirst: 4) pairsDo: [:variableName :variableData | + poolData last + at: variableName + put: (self nextVariable: variableName data: variableData)].! Item was added: + ----- Method: ExternalPoolLinesReadWriter>>loadPoolData (in category 'reading - fetch/interpret/clear/load') ----- + loadPoolData + + super loadPoolData. + + externalPool lastPlatform: poolData first. + + poolData second keysAndValuesDo: [:name :value | + "Be sure to convert the name into something compatible with Smalltalk." + externalPool at: (poolDefinition compatibleName: name) put: value].! Item was added: + ----- Method: ExternalPoolLinesReadWriter>>nextBooleanVariableFrom: (in category 'reading - interpret platform constants') ----- + nextBooleanVariableFrom: data + + ^ super nextBooleanVariableFrom: data, ' ~= 0'! Item was added: + ----- Method: ExternalPoolLinesReadWriter>>nextCharacterVariableFrom: (in category 'reading - interpret platform constants') ----- + nextCharacterVariableFrom: data + + ^ super nextCharacterVariableFrom: data, ' asCharacter'! Item was added: + ----- Method: ExternalPoolLinesReadWriter>>nextFloatVariableFrom: (in category 'reading - interpret platform constants') ----- + nextFloatVariableFrom: data + + ^ self class readFloatFrom: data readStream! Item was added: + ----- Method: ExternalPoolLinesReadWriter>>nextLiteralVariableFrom: (in category 'reading - interpret platform constants') ----- + nextLiteralVariableFrom: data + "Assume that the Smalltalk compiler/parser can handle the data now." + + ^ Compiler evaluate: data! Item was added: + ----- Method: ExternalPoolLinesReadWriter>>nextPointerVariableFrom: (in category 'reading - interpret platform constants') ----- + nextPointerVariableFrom: data + + self flag: #discuss. "mt: Maybe produce a byte array?" + ^ Compiler evaluate: '16r', data! Item was added: + ----- Method: ExternalPoolLinesReadWriter>>nextPutDefinition: (in category 'writing - serialization') ----- + nextPutDefinition: aPoolDefinition + + self nextPutPlatform: self platform. + + aPoolDefinition variablesAndTypesDo: [:variableName :type | + self + nextPutAll: variableName asString; + nextPutLineEnding; + nextPutVariable: variableName + type: type key + convertTo: type value; + nextPutLineEnding].! Item was added: + ----- Method: ExternalPoolLinesReadWriter>>nextPutPlatform: (in category 'writing - serialization') ----- + nextPutPlatform: aPlatform + + self + nextPutAll: aPlatform name asString; + nextPutLineEnding; + + nextPutAll: aPlatform osVersion asString; + nextPutLineEnding; + + nextPutAll: aPlatform subtype asString; + nextPutLineEnding; + + nextPutAll: aPlatform wordSize asString; + nextPutLineEnding.! Item was added: + ----- Method: ExternalPoolLinesReadWriter>>nextStringVariableFrom: (in category 'reading - interpret platform constants') ----- + nextStringVariableFrom: data + + ^ super nextStringVariableFrom: '''', data, ''''! Item was added: + ----- Method: ExternalPoolLinesReadWriter>>nextSymbolVariableFrom: (in category 'reading - interpret platform constants') ----- + nextSymbolVariableFrom: data + + ^ super nextSymbolVariableFrom: '#''', data, ''''! Item was added: + ----- Method: ExternalPoolLinesReadWriter>>storageFileName (in category 'pool data storage - configuration') ----- + storageFileName + "We output something in per line. Looks like a regular text file. Not binary." + + ^ self id, '.txt'! Item was added: + Object subclass: #ExternalPoolProgramCompiler + instanceVariableNames: 'cCompiler cFlags outputFilePath inputFilePath includePath commandProcessor workingPath' + classVariableNames: 'DefaultCCompiler DefaultCFlags DefaultCompilerClass DefaultIncludePath' + poolDictionaries: '' + category: 'FFI-Pools-Support'! + + !ExternalPoolProgramCompiler commentStamp: 'mt 6/2/2020 18:39' prior: 0! + I am an adapter for an external C compiler. I need OSProcess and an external compiler (e.g. GNU cc or Microsoft cl) to be installed on the (host) platform. If you have not yet read the class comment of ExternalPoolReadWriter, please do so to learn more about external pools.! Item was added: + ----- Method: ExternalPoolProgramCompiler class>>cleanUp: (in category 'initialize-release') ----- + cleanUp: aggressive + + aggressive ifTrue: [ + DefaultCCompiler := nil. + DefaultCFlags := nil. + DefaultCompilerClass := nil].! Item was added: + ----- Method: ExternalPoolProgramCompiler class>>convertedFilePath: (in category 'support') ----- + convertedFilePath: absoluteWindowsFilePath + "Only for Cygwin support. Sigh." + + ^ absoluteWindowsFilePath! Item was added: + ----- Method: ExternalPoolProgramCompiler class>>defaultCCompiler (in category 'preferences') ----- + defaultCCompiler + + <preference: 'Default C Compiler' + category: #'FFI Pools' + description: 'The external C compiler that will be invoked when defining external pools. Note that pool definitions can overwrite this.' + type: #String> + ^ DefaultCCompiler ifNil: [ + FFIPlatformDescription current isWindows + ifTrue: ['cl'] + ifFalse: ['cc']]! Item was added: + ----- Method: ExternalPoolProgramCompiler class>>defaultCCompiler: (in category 'preferences') ----- + defaultCCompiler: aString + + DefaultCCompiler := aString.! Item was added: + ----- Method: ExternalPoolProgramCompiler class>>defaultCFlags (in category 'preferences') ----- + defaultCFlags + + <preference: 'Default C Compiler Flags' + category: #'FFI Pools' + description: 'The flags for the external C compiler that will be invoked when defining external pools. Note that pool definitions can overwrite flags.' + type: #String> + ^ DefaultCFlags ifNil: [ + FFIPlatformDescription current isWindows + ifTrue: ['/Wall /I${INCLUDE} /out:${OUTPUT}'] + ifFalse: ['-Wall -I${INCLUDE} -o ${OUTPUT}']]! Item was added: + ----- Method: ExternalPoolProgramCompiler class>>defaultCFlags: (in category 'preferences') ----- + defaultCFlags: aString + + DefaultCFlags := aString.! Item was added: + ----- Method: ExternalPoolProgramCompiler class>>defaultCompilerClass (in category 'preferences') ----- + defaultCompilerClass + + <preference: 'Default Compiler Adapter' + category: 'FFI Pools' + description: 'There may be different classes to accommodate platform-specific invocation of external C compilers such as Cygwin on Windows.' + type: #Class> + + ^ DefaultCompilerClass ifNil: [ExternalPoolProgramCompiler]! Item was added: + ----- Method: ExternalPoolProgramCompiler class>>defaultCompilerClass: (in category 'preferences') ----- + defaultCompilerClass: aClass + + DefaultCompilerClass := aClass.! Item was added: + ----- Method: ExternalPoolProgramCompiler class>>defaultIncludePath (in category 'preferences') ----- + defaultIncludePath + + <preference: 'Default Include Path' + category: 'FFI Pools' + description: 'Given that all pool definitions specify header files with a relative file name, set the path to look for those headers during compilation.' + type: #String> + + ^ DefaultIncludePath ifNil: [ExternalPoolReadWriter workingPath]! Item was added: + ----- Method: ExternalPoolProgramCompiler class>>defaultIncludePath: (in category 'preferences') ----- + defaultIncludePath: aString + + DefaultIncludePath := aString.! Item was added: + ----- Method: ExternalPoolProgramCompiler class>>runExternalCommand: (in category 'support') ----- + runExternalCommand: externalCommand + + self new run: externalCommand.! Item was added: + ----- Method: ExternalPoolProgramCompiler>>cCompiler (in category 'accessing') ----- + cCompiler + + ^ cCompiler! Item was added: + ----- Method: ExternalPoolProgramCompiler>>cCompiler: (in category 'accessing') ----- + cCompiler: anObject + + cCompiler := anObject.! Item was added: + ----- Method: ExternalPoolProgramCompiler>>cFlags (in category 'accessing') ----- + cFlags + + ^ (cFlags + copyReplaceAll: '${OUTPUT}' with: self outputFilePath) + copyReplaceAll: '${INCLUDE}' with: self includePath! Item was added: + ----- Method: ExternalPoolProgramCompiler>>cFlags: (in category 'accessing') ----- + cFlags: anObject + + cFlags := anObject.! Item was added: + ----- Method: ExternalPoolProgramCompiler>>commandProcessor (in category 'accessing') ----- + commandProcessor + + ^ commandProcessor! Item was added: + ----- Method: ExternalPoolProgramCompiler>>commandProcessor: (in category 'accessing') ----- + commandProcessor: anObject + + commandProcessor := anObject.! Item was added: + ----- Method: ExternalPoolProgramCompiler>>ensureOSProcess (in category 'initialization') ----- + ensureOSProcess + + (self environment classNamed: #OSProcess) ifNil: [ + Installer ss project: 'OSProcess'; install: 'OSProcess'. + Installer ss project: 'CommandShell'; install: 'CommandShell'. + + (self environment classNamed: #OSProcess) ifNil: [ + self notify: 'OSProcess could not be loaded. If you have another processor for external commands, you can ignore this warning.']].! Item was added: + ----- Method: ExternalPoolProgramCompiler>>externalCommand (in category 'running') ----- + externalCommand + + ^ 'cd {1} && {2} {3} {4} {5}' + format: { + self workingPath. + self cCompiler. + self cFlags. + self inputFilePath}! Item was added: + ----- Method: ExternalPoolProgramCompiler>>includePath (in category 'accessing') ----- + includePath + + ^ includePath! Item was added: + ----- Method: ExternalPoolProgramCompiler>>includePath: (in category 'accessing') ----- + includePath: anObject + + includePath := anObject.! Item was added: + ----- Method: ExternalPoolProgramCompiler>>initialize (in category 'initialization') ----- + initialize + + super initialize. + + self cCompiler: self class defaultCCompiler. + self cFlags: self class defaultCFlags. + self includePath: self class defaultIncludePath. + + self ensureOSProcess. + self commandProcessor: (self environment classNamed: #OSProcess). + ! Item was added: + ----- Method: ExternalPoolProgramCompiler>>inputFilePath (in category 'accessing') ----- + inputFilePath + + ^ inputFilePath! Item was added: + ----- Method: ExternalPoolProgramCompiler>>inputFilePath: (in category 'accessing') ----- + inputFilePath: anObject + + inputFilePath := anObject.! Item was added: + ----- Method: ExternalPoolProgramCompiler>>outputFilePath (in category 'accessing') ----- + outputFilePath + + ^ outputFilePath! Item was added: + ----- Method: ExternalPoolProgramCompiler>>outputFilePath: (in category 'accessing') ----- + outputFilePath: anObject + + outputFilePath := anObject.! Item was added: + ----- Method: ExternalPoolProgramCompiler>>run (in category 'running') ----- + run + + self run: self externalCommand.! Item was added: + ----- Method: ExternalPoolProgramCompiler>>run: (in category 'running') ----- + run: command + + self commandProcessor + ifNil: [self error: 'No processor for external command configured.'] + ifNotNil: [:processor | self run: command with: processor].! Item was added: + ----- Method: ExternalPoolProgramCompiler>>run:with: (in category 'running') ----- + run: command with: processor + + | result | + result := processor waitForCommand: command. + result succeeded ifFalse: [ + self error: 'Failed to compile generated source code.'].! Item was added: + ----- Method: ExternalPoolProgramCompiler>>workingPath (in category 'accessing') ----- + workingPath + + ^ workingPath! Item was added: + ----- Method: ExternalPoolProgramCompiler>>workingPath: (in category 'accessing') ----- + workingPath: anObject + + workingPath := anObject.! Item was added: + ExternalPoolProgramCompiler subclass: #ExternalPoolProgramCompilerForCygwin + instanceVariableNames: '' + classVariableNames: 'BashFilePath' + poolDictionaries: '' + category: 'FFI-Pools-Support'! + + !ExternalPoolProgramCompilerForCygwin commentStamp: 'mt 5/31/2020 19:53' prior: 0! + I can talk to an external GCC compiler through Cygwin on a Windows platform. I convert all Windows file paths to the "/cygdrive/letter/path" format.! Item was added: + ----- Method: ExternalPoolProgramCompilerForCygwin class>>bashFilePath (in category 'preferences') ----- + bashFilePath + <preference: 'Cygwin Bash' + category: 'FFI Pools' + description: 'Path to Cygwin''s bash to be invoked for program compilation.' + type: #String> + ^ BashFilePath ifNil: [ + FFIPlatformDescription current wordSize = 4 + ifTrue: ['C:\cygwin\bin\bash.exe'] + ifFalse: ['C:\cygwin64\bin\bash.exe']]! Item was added: + ----- Method: ExternalPoolProgramCompilerForCygwin class>>bashFilePath: (in category 'preferences') ----- + bashFilePath: aString + + BashFilePath := aString.! Item was added: + ----- Method: ExternalPoolProgramCompilerForCygwin class>>convertedFilePath: (in category 'support') ----- + convertedFilePath: absoluteWindowsFilePath + + | driveLetter path | + (absoluteWindowsFilePath beginsWith: '\\?\' "UNC paths") + ifTrue: [ + driveLetter := absoluteWindowsFilePath at: 5. "e.g., \\?\C:\Program Files\readme.txt" + path := absoluteWindowsFilePath allButFirst: 6 "skip colon"] + ifFalse: [ + driveLetter := absoluteWindowsFilePath at: 1. "e.g., C:\Program Files\readme.txt" + path := absoluteWindowsFilePath allButFirst: 2 "skip colon"]. + + ^ '/cygdrive/{1}{2}' format: { + driveLetter. + path copyReplaceAll: '\' with: '/'}! Item was added: + ----- Method: ExternalPoolProgramCompilerForCygwin class>>runExternalCommand: (in category 'support') ----- + runExternalCommand: externalCommand + "Run the external command through the Cygwin bash because our compiled programs usually depend on Cygwin1.dll, which will not be found when just using the Windows command shell." + + self new run: ('{1} -l -c "{2}"' + format: { + self bashFilePath. + externalCommand}).! Item was added: + ----- Method: ExternalPoolProgramCompilerForCygwin>>externalCommand (in category 'running') ----- + externalCommand + "Invoke external compiler through Cygwin bash to have all environment variables set up properly." + + ^ '{1} -l -c "{2} {3} {4}"' + format: { + self class bashFilePath. + self cCompiler. + self cFlags. + self inputFilePath}! Item was added: + ----- Method: ExternalPoolProgramCompilerForCygwin>>includePath: (in category 'accessing') ----- + includePath: path + + super includePath: (self class convertedFilePath: path).! Item was added: + ----- Method: ExternalPoolProgramCompilerForCygwin>>inputFilePath: (in category 'accessing') ----- + inputFilePath: path + + super inputFilePath: (self class convertedFilePath: path).! Item was added: + ----- Method: ExternalPoolProgramCompilerForCygwin>>outputFilePath: (in category 'accessing') ----- + outputFilePath: path + + super outputFilePath: (self class convertedFilePath: path).! Item was added: + ----- Method: ExternalPoolProgramCompilerForCygwin>>run:with: (in category 'running') ----- + run: command with: processor + "Check for misconfiguration of compiler. Do not use #waitForCommand: because OSProcess has difficulties with Cygwin bash being opened in a Windows command shell." + + | result | + self cCompiler = 'cl' ifTrue: [ + self notify: ('There is probably the wrong C compiler (i.e. ''{1}'') configured for this Cygwin adapter. Please verify that in your pool definition or the system preferences.' format: {self cCompiler})]. + + result := processor command: command. + 2 seconds wait.! Item was added: + ----- Method: ExternalPoolProgramCompilerForCygwin>>workingPath: (in category 'accessing') ----- + workingPath: path + + super workingPath: (self class convertedFilePath: path).! Item was added: + Object subclass: #ExternalPoolProgramGenerator + instanceVariableNames: 'stream lineEnding cHeaders' + classVariableNames: 'DefaultGeneratorClass' + poolDictionaries: '' + category: 'FFI-Pools-Support'! + + !ExternalPoolProgramGenerator commentStamp: 'mt 6/2/2020 18:38' prior: 0! + This class generates a C program that outputs serialized pool data. Program generators have to be control from within a read-writer. If you have not yet read the class comment of ExternalPoolReadWriter, please do so to learn more about external pools.! Item was added: + ----- Method: ExternalPoolProgramGenerator class>>defaultGeneratorClass (in category 'preferences') ----- + defaultGeneratorClass + + <preference: 'Default C Program Generator' + category: 'FFI Pools' + description: 'The generator to produce the C program when external pools are developed.' + type: #Class> + + ^ DefaultGeneratorClass ifNil: [ExternalPoolProgramGenerator]! Item was added: + ----- Method: ExternalPoolProgramGenerator class>>defaultGeneratorClass: (in category 'preferences') ----- + defaultGeneratorClass: aClass + + DefaultGeneratorClass := aClass.! Item was added: + ----- Method: ExternalPoolProgramGenerator class>>on:lineEnding:cHeaders: (in category 'instance creation') ----- + on: aStream lineEnding: aLineEnding cHeaders: aHeaderPathCollection + + ^ self new + setStream: aStream + lineEnding: aLineEnding + cHeaders: aHeaderPathCollection! Item was added: + ----- Method: ExternalPoolProgramGenerator>>cHeaders (in category 'accessing') ----- + cHeaders + ^ cHeaders! Item was added: + ----- Method: ExternalPoolProgramGenerator>>cr (in category 'emitting') ----- + cr + "Compatibility with stream protocol." + self emitLineEnding.! Item was added: + ----- Method: ExternalPoolProgramGenerator>>crlf (in category 'emitting') ----- + crlf + "Compatibility with stream protocol." + self emitLineEnding.! Item was added: + ----- Method: ExternalPoolProgramGenerator>>defaultHeaders (in category 'defaults') ----- + defaultHeaders + ^ #('<errno.h>' '<stdarg.h>' '<stddef.h>' '<stdio.h>' '<stdlib.h>' '<string.h>' '<float.h>' '<inttypes.h>')! Item was added: + ----- Method: ExternalPoolProgramGenerator>>emit: (in category 'emitting') ----- + emit: aCharacter + + self flag: #discuss. "mt: This guard cannot work to detect false crlf line endings here because it would yield two line-ending characters then." + (aCharacter == Character cr or: [aCharacter == Character lf]) + ifTrue: [^ self stream nextPutAll: self lineEnding]. + + self stream nextPut: aCharacter.! Item was added: + ----- Method: ExternalPoolProgramGenerator>>emitAll: (in category 'emitting') ----- + emitAll: aString + 1 to: aString size do: [:i | + self emit: (aString at: i)]! Item was added: + ----- Method: ExternalPoolProgramGenerator>>emitAll:format: (in category 'emitting') ----- + emitAll: aTemplateString format: aSequenceableCollectionOrDictionary + "works similar to String>>#format:, except it uses '${xxx}' syntax + for macro expansion, which is more convenient for C" + + | templateReadStream | + + templateReadStream := aTemplateString asString readStream. + [templateReadStream atEnd] + whileFalse: [| nextChar | + ((nextChar := templateReadStream next) == $$ + and: [templateReadStream peekFor: ${]) + ifTrue: [| key | + key := templateReadStream upTo: $}. + self emitAll: + (aSequenceableCollectionOrDictionary at: + (aSequenceableCollectionOrDictionary isDictionary + ifTrue: [key] + ifFalse: [key asUnsignedInteger])) asString] + ifFalse: [self emit: nextChar]].! Item was added: + ----- Method: ExternalPoolProgramGenerator>>emitDefaultHeaders (in category 'emitting - headers') ----- + emitDefaultHeaders + self defaultHeaders do: [:each | + self emitHeader: each]! Item was added: + ----- Method: ExternalPoolProgramGenerator>>emitDefinitionHeaders (in category 'emitting - headers') ----- + emitDefinitionHeaders + self cHeaders do: [:each | + self emitHeader: each]! Item was added: + ----- Method: ExternalPoolProgramGenerator>>emitEndMainFunctionDefinition (in category 'emitting - function definitions') ----- + emitEndMainFunctionDefinition + self + emitAll: + ' + if (fflush(file) !!= 0) { + ${1}("Can''t flush file", errno); + return EXIT_FAILURE; + } + if (file !!= stdout) { + if (fclose(file) !!= 0) { + ${1}("Can''t close file", errno); + return EXIT_FAILURE; + } + } + + return EXIT_SUCCESS; + } + ' + format: {self errorFunctionName}! Item was added: + ----- Method: ExternalPoolProgramGenerator>>emitEpilog (in category 'emitting - single C file') ----- + emitEpilog + self emitEndMainFunctionDefinition! Item was added: + ----- Method: ExternalPoolProgramGenerator>>emitErrorFunctionDefinition (in category 'emitting - function definitions') ----- + emitErrorFunctionDefinition + self + emitAll: ' + static void ${1}(const char *message, int error) + { + fprintf(stderr, "%s: %s\n", message, strerror(error)); + ${2} + } + ' + format: { + self errorFunctionName. + self generatedProgramExitsOnError + ifTrue: ['exit(EXIT_FAILURE);'] + ifFalse: ['/* no exit on error */']}! Item was added: + ----- Method: ExternalPoolProgramGenerator>>emitFileCommentFrom: (in category 'emitting - single C file') ----- + emitFileCommentFrom: anExternalPoolReadWriter + + self emitMultilineComment: ( + 'This file was automatically generated by {1}.\\The program emits the serialization format of {2}.\\{3}\{4}\{5}' withCRs format: { + self class name. + anExternalPoolReadWriter ifNil: ['<unknown origin>'] ifNotNil: [:obj | obj class name]. + DateAndTime now. + Smalltalk version. + self class workingCopy description }).! Item was added: + ----- Method: ExternalPoolProgramGenerator>>emitFunctionDefinitions (in category 'emitting - function definitions') ----- + emitFunctionDefinitions + self + emitErrorFunctionDefinition; + emitPrintfFunctionDefinition; + emitPutcFunctionDefinition; + emitStringOutputFunctionDefinition! Item was added: + ----- Method: ExternalPoolProgramGenerator>>emitHeader: (in category 'emitting - headers') ----- + emitHeader: aHeaderPath + self + emitAll: '#include ${1} + ' + format: {aHeaderPath}! Item was added: + ----- Method: ExternalPoolProgramGenerator>>emitHeaders (in category 'emitting - headers') ----- + emitHeaders + self + emitDefaultHeaders; + emitLineEnding; + emitDefinitionHeaders! Item was added: + ----- Method: ExternalPoolProgramGenerator>>emitLineEnding (in category 'emitting') ----- + emitLineEnding + self stream nextPutAll: self lineEnding! Item was added: + ----- Method: ExternalPoolProgramGenerator>>emitMultilineComment: (in category 'emitting') ----- + emitMultilineComment: aStringOrArray + + | comment maxLength | + maxLength := 80. + comment := aStringOrArray isString not + ifFalse: [aStringOrArray] + ifTrue: [aStringOrArray joinSeparatedBy: self lineEnding]. + self flag: #todo. "mt: Escape combinations of */ in the comment." + comment := comment withNoLineLongerThan: maxLength - 3 " * ". + + self + emitAll: '/*'; + emitLineEnding. + + comment linesDo: [:line | + self + emitAll: ' * '; emitAll: line; + emitLineEnding]. + + self + emitAll: ' */'; + emitLineEnding; + emitLineEnding.! Item was added: + ----- Method: ExternalPoolProgramGenerator>>emitOutputCode: (in category 'emitting - single C file') ----- + emitOutputCode: code + "Callback from read-writer." + + self + emitOutputCode: code + escaped: true.! Item was added: + ----- Method: ExternalPoolProgramGenerator>>emitOutputCode:escaped: (in category 'emitting - single C file') ----- + emitOutputCode: code escaped: escaped + "Callback from read-writer. Emit code as C string to eventually print that code to, for example, stdout or another file or any character buffer." + + self + tab; + emitAll: self printfFunctionName; + emitAll: '(file, '. + + escaped + ifTrue: [self emitStringLiteral: code asString] + ifFalse: [self emitStringLiteralAsIs: code asString]. + + self + emitAll: ');'; + emitLineEnding.! Item was added: + ----- Method: ExternalPoolProgramGenerator>>emitPrintfFunctionDefinition (in category 'emitting - function definitions') ----- + emitPrintfFunctionDefinition + self + emitAll: ' + static int ${1}(FILE *file, const char *format, ...) + { + va_list ap; + int rv; + + va_start(ap, format); + if ((rv = vfprintf(file, format, ap)) >= 0) { + va_end(ap); + } else { + int err = errno; /* save errno */ + va_end(ap); + ${2}("Can''t print to file", err); + } + + return rv; + } + ' + format: {self printfFunctionName. self errorFunctionName}! Item was added: + ----- Method: ExternalPoolProgramGenerator>>emitPrologFrom: (in category 'emitting - single C file') ----- + emitPrologFrom: anExternalPoolReadWriter + self + emitFileCommentFrom: anExternalPoolReadWriter; + emitHeaders; + emitFunctionDefinitions; + emitStartMainFunctionDefinition! Item was added: + ----- Method: ExternalPoolProgramGenerator>>emitPutcFunctionDefinition (in category 'emitting - function definitions') ----- + emitPutcFunctionDefinition + self + emitAll: ' + static int ${1}(int c, FILE *file) + { + int rv; + + if ((rv = fputc(c, file)) == EOF) + ${2}("Can''t print to file", errno); + + return rv; + } + ' + format: {self putcFunctionName. self errorFunctionName}! Item was added: + ----- Method: ExternalPoolProgramGenerator>>emitStartMainFunctionDefinition (in category 'emitting - function definitions') ----- + emitStartMainFunctionDefinition + self + emitAll: ' + int main(int argc, char *argv[]) + { + FILE *file; + + if (argc > 1) { + if ((file = fopen(argv[1], "wb")) == NULL) { + ${1}("Can''t open file", errno); + return EXIT_FAILURE; + } + } else { + file = stdout; + } + + ' + format: {self errorFunctionName}! Item was added: + ----- Method: ExternalPoolProgramGenerator>>emitStringLiteral: (in category 'emitting') ----- + emitStringLiteral: aString + "Emit given Smalltalk string as C string. That is, escape double-quotes and backslash." + + self emit: $". + aString do: [:each | + (each == $" + or: [each == $\]) + ifTrue: [self emit: $\]. + self emit: each]. + self emit: $".! Item was added: + ----- Method: ExternalPoolProgramGenerator>>emitStringLiteralAsIs: (in category 'emitting') ----- + emitStringLiteralAsIs: aString + "Emit given Smalltalk string as C string. Escape double-quotes only. Use this to emit C string compatible escape sequences." + + self emit: $". + aString do: [:each | + each == $" ifTrue: [self emit: $\]. + self emit: each]. + self emit: $".! Item was added: + ----- Method: ExternalPoolProgramGenerator>>emitStringOutputFunctionDefinition (in category 'emitting - function definitions') ----- + emitStringOutputFunctionDefinition + self + emitAll: ' + static void ${1}(FILE *file, const char *s) + { + while (*s !!= ''\0'') { + if (*s == ''\'''') + ${2}(''\'''', file); /* escape the subquote */ + ${2}(*s++, file); + } + } + ' + format: + {self stringOutputFunctionName. + self putcFunctionName}! Item was added: + ----- Method: ExternalPoolProgramGenerator>>emitVariable:cFormat:cType: (in category 'emitting - single C file') ----- + emitVariable: anIdentifier cFormat: cFormatPlaceholder cType: cTypeName + + self tab. + + self + emitAll: '${1}(file, "${2}", (${3}) ${4});' + format: { + self printfFunctionName. + cFormatPlaceholder. + cTypeName. + anIdentifier}. + + self emitLineEnding.! Item was added: + ----- Method: ExternalPoolProgramGenerator>>emitVariableAsCString: (in category 'emitting - single C file') ----- + emitVariableAsCString: anIdentifier + + self tab. + + self + emitAll: '${1}(file, ${2});' + format: {self stringOutputFunctionName. anIdentifier}. + + self emitLineEnding.! Item was added: + ----- Method: ExternalPoolProgramGenerator>>emitVariableAsMaxPrecisionFloat:cType: (in category 'emitting - single C file') ----- + emitVariableAsMaxPrecisionFloat: anIdentifier cType: cTypeName + "Needs <float.h>. See https://stackoverflow.com/questions/16839658/printf-width-specifier-to-main…" + + self tab. + + self + emitAll: '${1}(file, "%.*e", DECIMAL_DIG, (${2}) ${3});' + format: { + self printfFunctionName. + cTypeName. + anIdentifier}. + + self emitLineEnding.! Item was added: + ----- Method: ExternalPoolProgramGenerator>>emitVariableAsPointerAddress: (in category 'emitting - single C file') ----- + emitVariableAsPointerAddress: anIdentifier + "Overrides %p printing to use a cross-platform way to print pointers. Needs <inttypes.h>. See https://stackoverflow.com/questions/9053658/correct-format-specifier-to-pri…. Assume that all kinds of pointers (void*, int*, ...) are the same sizeof." + + self tab. + + self + emitAll: '${1}(file, "%" PRIXPTR, (uintptr_t)${2});' + format: { + self printfFunctionName. + anIdentifier}. + + self emitLineEnding.! Item was added: + ----- Method: ExternalPoolProgramGenerator>>errorFunctionName (in category 'defaults') ----- + errorFunctionName + ^ self functionNamed: 'Error'! Item was added: + ----- Method: ExternalPoolProgramGenerator>>functionNamed: (in category 'defaults') ----- + functionNamed: aPartialFunctionName + ^ self functionNamespace, aPartialFunctionName! Item was added: + ----- Method: ExternalPoolProgramGenerator>>functionNamespace (in category 'defaults') ----- + functionNamespace + ^ 'ffiExternalSharedPool'! Item was added: + ----- Method: ExternalPoolProgramGenerator>>generatedProgramExitsOnError (in category 'testing') ----- + generatedProgramExitsOnError + ^ true! Item was added: + ----- Method: ExternalPoolProgramGenerator>>lf (in category 'emitting') ----- + lf + "Compatibility with stream protocol." + self emitLineEnding.! Item was added: + ----- Method: ExternalPoolProgramGenerator>>lineEnding (in category 'accessing') ----- + lineEnding + ^ lineEnding! Item was added: + ----- Method: ExternalPoolProgramGenerator>>printfFunctionName (in category 'defaults') ----- + printfFunctionName + ^ self functionNamed: 'Printf'! Item was added: + ----- Method: ExternalPoolProgramGenerator>>putcFunctionName (in category 'defaults') ----- + putcFunctionName + ^ self functionNamed: 'Putc'! Item was added: + ----- Method: ExternalPoolProgramGenerator>>setLineEnding: (in category 'initialization') ----- + setLineEnding: newLineEnding + "For testing and debugging only. Please do not change the line ending while the generator is running." + + lineEnding := newLineEnding asString.! Item was added: + ----- Method: ExternalPoolProgramGenerator>>setStream:lineEnding:cHeaders: (in category 'initialization') ----- + setStream: aStream lineEnding: aStringOrCharacter cHeaders: aHeaderPathCollection + + stream := aStream. + cHeaders := aHeaderPathCollection. + lineEnding := aStringOrCharacter asString.! Item was added: + ----- Method: ExternalPoolProgramGenerator>>stream (in category 'accessing') ----- + stream + ^ stream! Item was added: + ----- Method: ExternalPoolProgramGenerator>>stringOutputFunctionName (in category 'defaults') ----- + stringOutputFunctionName + ^ self functionNamed: 'OutputString'! Item was added: + ----- Method: ExternalPoolProgramGenerator>>tab (in category 'emitting') ----- + tab + "Compatibility with stream protocol." + self emit: Character tab.! Item was added: + Object subclass: #ExternalPoolReadWriter + instanceVariableNames: 'externalPool poolDefinition programGenerator poolData' + classVariableNames: 'AtomicCFormatPlaceholders AtomicCTypeNames' + poolDictionaries: '' + category: 'FFI-Pools'! + + !ExternalPoolReadWriter commentStamp: 'mt 6/2/2020 18:36' prior: 0! + (NOTICE: If you have not yet read the class comment of ExternalPool, please do so before reading further.) + (NOTICE: If you have not yet read the class comment of ExternalPoolDefinition, please do so before reading further.) + + This class is responsible for writing and reading pool data; it also provides the knowledge about available pool-data storage, which is the mediator between the writing phase (aka. development time) and the reading phase (aka. deployment time). + + + 1. WRITING POOL DATA - DEVELOPING AN EXTERNAL POOL + + The writing phase (i.e., #writePoolData) distinguishes four steps: + 1. Generate a program source file in C + 2. Employ an external C compiler to compile that generated file + 3. Invoke that compiled program file to collect the pool data + 4. Store the pool data + + Note that all steps have to be in harmony. The C program generator has to generate a valid program, which the C compiler can understand. No syntax errors. No missing header files. After that, program invocation (or running) requires knowledge about the kind of program. That is, whether to run it as an external process or make an FFI call if it is a library. Finally, storage depends on where the pool data is currently located. This is usually somewhere in the same #workinPath, but could already be in image if an FFI call was made. + + You can read more about program generation and compilation by reading the class comment of ExternalPoolProgramGenerator and ExternalPoolProgramCompiler, respectively. There are system-wide preferences under "FFI Pools" to use custom generators or compilers -- if present. Note that this information is not stored per pool definition because it only affects the development time, not the deployment time. Every developer can setup her own platform to work on external pools. + + + 1.1. SERIALIZATION FORMAT + + Since collecting an external pool's values entails running an external program on the host platform (i.e., not in the image), pool-data serialization spreads across program generation, program compilation, and program execution. Only after all these steps, one can explore the actual serialization form of the pool data. (Note that there is typically extensive use of printf in the C program to extract pool data.) + + To serialize a pool definition, a read-writer has to implement #nextPutDefinition:. In that implementation, there should be a call to #nextPutPlatform: as well as the definition's enumeration method #variablesAndTypesDo: and #nextPutVariable:type:convertTo:. See this class' #nextPutDefinition: as an inspiration (and documentation). + + Besides platform constants, a read-writer can offer methods to serialize image constants. For example, writing information about the current platform description into the pool data is such an image constant. + + (Note that whatever efforts are saved during serialization, are likely to be made during pool-data interpretation (aka. de-serialization ... or un-marshalling for binary formats). See implementors of #interpretPoolData). + + + 2. READING POOL DATA - DEPLOYING AN EXTERNAL POOL + + The overall goal for deploying an external pool is to depend on as little extra machinery as possible, that is, no external C compiler, no OSProcess, maybe not even a file plugin or Internet access. ;-) Requirements depend on the storage strategy for pool data. + + The reading phase (i.e., #readPoolData) distinguishes four steps: + 1. Fetch pool data from storage, starting with the definition's preferred one + 2. Interpret pool data to create structured information as Smalltalk objects + 3. Discard all current values in the external pool to support platform-specific variable masking + 4. Load all values from the (now structured) pool data into the external pool + + So, if the pool-data storage would be in the image and no external services would be required for interpreting that data, the entire reading workflow would be self-contained in the image. But whether this is an achievable goal is to be discussed. While a backup storage could always be in the file system, relying fully on such a storage would allow for fixing images that wouldn't start because of some bad external pool value in combination with an FFI call. + + + 3. MORE DETAILS + + If you want to learn more about read-writers, we suggest exploring: + - all methods in the 'pool data storage' protocol + - all implementors of #nextPutDefinition: + - the implementation of #nextPutVariable:type:convertTo: (in 'writing ...') + - the implementation of #nextVariable:data: (in 'reading ...') + - all methods in the protocols that end with 'platform constants' + - all implementors of #interpretPoolData + - all implementors of #loadPoolData + + You should also take a look at the following classes: + - ExternalPoolProgramGenerator + - ExternalPoolProgramCompiler + + Have fun!! + + ! Item was added: + ----- Method: ExternalPoolReadWriter class>>initialize (in category 'class initialization') ----- + initialize + + self initializeAtomicTypesExtra.! Item was added: + ----- Method: ExternalPoolReadWriter class>>initializeAtomicTypesExtra (in category 'class initialization') ----- + initializeAtomicTypesExtra + "Initialize C type names and format placeholders for printf, which are used during C code generation. The implementation follows the one for initialization of atomic types in ExternalType. Even though all type names are repeated here explicitely, their location in the list of atomic types is looked up dynamically. So you can change the order to improve readability." + + | type typeName cTypeName cFormatPlaceholder | + self flag: #ffiLongVsInt. + + AtomicCTypeNames := IdentityDictionary new. + AtomicCFormatPlaceholders := IdentityDictionary new. + + #( + "name C type name C printf % format" + ('void' 'void' 'p') + ('bool' 'unsigned int' 'u') "See ByteArray >> #booleanAt:" + ('byte' 'unsigned char' 'hhu') "Not 'c' to avoid conversion issues" + ('sbyte' 'signed char' 'hhd') "Not 'c' to avoid conversion issues" + ('ushort' 'unsigned short' 'hu') + ('short' 'signed short' 'hd') + "!!!!!!" ('ulong' 'unsigned int' 'u') "Not 'lu' bc. not unsigned long, see above" + "!!!!!!" ('long' 'signed int' 'd') "Not 'ld' bc. not signed long, see above" + ('ulonglong' 'unsigned long long' 'llu') + ('longlong' 'signed long long' 'lld') + ('char' 'unsigned char' 'hhu') "Not 'c' to avoid conversion issues" + ('schar' 'signed char' 'hhd') "Not 'c' to avoid conversion issues" + ('float' 'float' 'g') "Not 'G' bc. notation in lowercase letters" + ('double' 'double' 'g') "Not 'G' bc. notation in lowercase letters" + "TODO: ('longdouble' 'long double' 'Lg')" + ) do: [:typeSpec | + typeName := typeSpec first. + cTypeName := typeSpec second. + cFormatPlaceholder := '%', typeSpec third. + + type := ExternalType atomicTypeNamed: typeName. + AtomicCTypeNames at: type atomicType put: cTypeName. + AtomicCFormatPlaceholders at: type atomicType put: cFormatPlaceholder].! Item was added: + ----- Method: ExternalPoolReadWriter class>>on: (in category 'instance creation') ----- + on: externalPool + "The pool read-writer will automatically select the preferred definition for the current platform. There will be an error if only the default definition is compatible." + + ^ self new setPool: externalPool! Item was added: + ----- Method: ExternalPoolReadWriter class>>onDefinition: (in category 'instance creation') ----- + onDefinition: externalPoolDefinition + "The pool read-writer will focus on the given definition, which may not be appropriate for the current platform. Just it for debugging or to improve your CI build scripts." + + ^ self new setPoolDefinition: externalPoolDefinition! Item was added: + ----- Method: ExternalPoolReadWriter class>>readFloatFrom: (in category 'parsing support') ----- + readFloatFrom: aStreamOrString + ^ self + readFloatFrom: aStreamOrString + ifFail: [nil]! Item was added: + ----- Method: ExternalPoolReadWriter class>>readFloatFrom:ifFail: (in category 'parsing support') ----- + readFloatFrom: aStreamOrString ifFail: aBlock + "This method is a wrapper around #readFrom:ifFail: that adds support + for C's printf() printed float representations of nan and +/- infinity" + + | readStream startPosition isNegative | + + readStream := + aStreamOrString isStream + ifTrue: [aStreamOrString] + ifFalse: [aStreamOrString readStream]. + startPosition := readStream position. + + (isNegative := readStream peekFor: $-) + ifFalse: [readStream peekFor: $+]. + + ((readStream nextMatchAll: 'infinity') + or: [(readStream nextMatchAll: 'INFINITY') + or: [(readStream nextMatchAll: 'inf') + or: [(readStream nextMatchAll: 'INF')]]]) + ifTrue: [ + ^ isNegative + ifTrue: [Float negativeInfinity] + ifFalse: [Float infinity]]. + + ((readStream nextMatchAll: 'nan') + or: [readStream nextMatchAll: 'NAN']) + ifTrue: [^ Float nan]. + + readStream position: startPosition. + ^ Float + readFrom: readStream + ifFail: aBlock.! Item was added: + ----- Method: ExternalPoolReadWriter class>>workingPath (in category 'defaults') ----- + workingPath + "Answers the working path to be used for all file-related activities." + + | path | + path := Smalltalk imagePath. + ^ (path endsWith: FileDirectory slash) + ifTrue: [path] + ifFalse: [path, FileDirectory slash]! Item was added: + ----- Method: ExternalPoolReadWriter>>cFormatPlaceholderFor: (in category 'writing - support') ----- + cFormatPlaceholderFor: externalType + "Limit access to printf format placeholders to instances of pool read-writers only." + + ^ externalType isPointerType + ifTrue: ['%p'] + ifFalse: [ + AtomicCFormatPlaceholders + at: externalType atomicType + ifAbsent: [nil]]! Item was added: + ----- Method: ExternalPoolReadWriter>>cTypeNameFor: (in category 'writing - support') ----- + cTypeNameFor: externalType + "Limit access to C type names to instances of pool read-writers only." + + | cTypeName | + cTypeName := AtomicCTypeNames + at: externalType atomicType + ifAbsent: [nil]. + + ^ externalType isPointerType + ifTrue: [cTypeName, ' *'] + ifFalse: [cTypeName]! Item was added: + ----- Method: ExternalPoolReadWriter>>clearPoolData (in category 'reading - fetch/interpret/clear/load') ----- + clearPoolData + "Discard all variables from the external pool that are masked through the current pool definition." + + self flag: #notice. "It is important to *NOT REMOVE* pool variables that are not in the current pool definition. The bindings behind those variables might be referenced in some loaded packages." + + poolDefinition variablesAndTypes keysDo: [:variableName | + "Explicit enumeration to not ignore variables that are skipped in the definition." + externalPool + at: (poolDefinition compatibleName: variableName) + put: nil].! Item was added: + ----- Method: ExternalPoolReadWriter>>compileProgramFile (in category 'writing - generate/compile/run/store') ----- + compileProgramFile + + | compiler | + compiler := self programCompilerClass new. + + "Configure the definition's overrides to the compiler's default settings." + poolDefinition cCompiler + ifNotEmpty: [:cc | compiler cCompiler: cc]. + poolDefinition cFlags + ifNotEmpty: [:flags | compiler cFlags: flags]. + + "Configure which artifact to compile." + compiler + workingPath: self class workingPath; + outputFilePath: self compiledProgramFilePath; + inputFilePath: self generatedProgramSourceFilePath. + + "Finally, compile!!" + FileDirectory default deleteFileNamed: self compiledProgramFilePath. + compiler run. + (FileDirectory default fileExists: self compiledProgramFilePath) + ifFalse: [self error: 'Compilation failed. Could not find compiled progam.'].! Item was added: + ----- Method: ExternalPoolReadWriter>>compiledProgramFileName (in category 'writing - defaults') ----- + compiledProgramFileName + + ^ self id, + (FFIPlatformDescription current isWindows + ifTrue: ['.exe'] ifFalse: [''])! Item was added: + ----- Method: ExternalPoolReadWriter>>compiledProgramFilePath (in category 'writing - defaults') ----- + compiledProgramFilePath + + ^ self pathToWriteTo, self compiledProgramFileName! Item was added: + ----- Method: ExternalPoolReadWriter>>cr (in category 'writing - C generator') ----- + cr + + programGenerator + emitOutputCode: '\r' + escaped: false.! Item was added: + ----- Method: ExternalPoolReadWriter>>ensureParsingSupport (in category 'initialization') ----- + ensureParsingSupport + "Ensure the support for understanding (and producing) this read-writers serialization format." + + self subclassResponsibility.! Item was added: + ----- Method: ExternalPoolReadWriter>>fetchFromFile (in category 'pool data storage - strategies') ----- + fetchFromFile + <ffiPoolDataStorage: #file> + <read> + + FileStream + readOnlyFileNamed: self storagePath, self storageFileName + do: [:stream | poolData := stream upToEnd].! Item was added: + ----- Method: ExternalPoolReadWriter>>fetchFromMethodSource (in category 'pool data storage - strategies') ----- + fetchFromMethodSource + <ffiPoolDataStorage: #methodSource> + <read> + + | selector class | + selector := (poolDefinition name, 'Data') asSymbol. + class := externalPool. + + poolData := class perform: selector.! Item was added: + ----- Method: ExternalPoolReadWriter>>fetchFromMethodSourceCompact (in category 'pool data storage - strategies') ----- + fetchFromMethodSourceCompact + <ffiPoolDataStorage: #methodSourceCompact> + <read> + + ^ self fetchFromMethodSource! Item was added: + ----- Method: ExternalPoolReadWriter>>fetchFromMethodString (in category 'pool data storage - strategies') ----- + fetchFromMethodString + <ffiPoolDataStorage: #methodString> + <read> + + | selector class | + selector := (poolDefinition name, 'Data') asSymbol. + class := externalPool. + + poolData := class perform: selector.! Item was added: + ----- Method: ExternalPoolReadWriter>>fetchPoolData (in category 'reading - fetch/interpret/clear/load') ----- + fetchPoolData + "Use the storage strategy associated with the current definition and fetch the pool data." + + self flag: #todo. "mt: Try all available storage strategies, but start the the one configured in the pool definition." + + [^ self executeMethod: ((self knownStorageStrategies at: poolDefinition poolDataStorage) at: #read)] + on: Error do: [:ex | self error: ('Could not fetch pool data for {1} via #{2} storage : [{3}] {4} ' + format: {self id. poolDefinition poolDataStorage. ex class name. ex messageText})]! Item was added: + ----- Method: ExternalPoolReadWriter>>generateProgramSourceFile (in category 'writing - generate/compile/run/store') ----- + generateProgramSourceFile + + FileDirectory default assureExistenceOfPath: self pathToWriteTo. + + "Use #forceNewFileNamed: to ensure truncation of existing files before writing." + StandardFileStream + forceNewFileNamed: self pathToWriteTo, self generatedProgramSourceFileName + do: [:writeStream | + writeStream ascii. + writeStream nextPutAll: self generatedProgramSource].! Item was added: + ----- Method: ExternalPoolReadWriter>>generatedProgramSource (in category 'writing - generate/compile/run/store') ----- + generatedProgramSource + "Employs the program generator as configured in the current pool definition to generate program source code. Answers that source code as Smalltalk string." + + self assert: programGenerator isNil. + + ^ String streamContents: [:stream | + programGenerator := self programGeneratorClass + on: stream + lineEnding: (poolDefinition platform isWindows ifTrue: [String crlf] ifFalse: [String lf]) + cHeaders: poolDefinition cHeaders. + programGenerator emitPrologFrom: self. + self nextPutDefinition: poolDefinition. + programGenerator emitEpilog. + programGenerator := nil].! Item was added: + ----- Method: ExternalPoolReadWriter>>generatedProgramSourceFileName (in category 'writing - defaults') ----- + generatedProgramSourceFileName + ^ self id, '.c'! Item was added: + ----- Method: ExternalPoolReadWriter>>generatedProgramSourceFilePath (in category 'writing - defaults') ----- + generatedProgramSourceFilePath + ^ self pathToWriteTo, self generatedProgramSourceFileName! Item was added: + ----- Method: ExternalPoolReadWriter>>id (in category 'accessing') ----- + id + "Answers an id for the current pool definition, which can be used as file prefix or key in another database for storage." + + ^ externalPool name asString, '-', poolDefinition name! Item was added: + ----- Method: ExternalPoolReadWriter>>initialize (in category 'initialization') ----- + initialize + + super initialize. + self ensureParsingSupport.! Item was added: + ----- Method: ExternalPoolReadWriter>>interpretPoolData (in category 'reading - fetch/interpret/clear/load') ----- + interpretPoolData + "Convert poolData into a structured Smalltalk object so that the pool values can be loaded into the pool." + + self subclassResponsibility.! Item was added: + ----- Method: ExternalPoolReadWriter>>knownStorageStrategies (in category 'pool data storage') ----- + knownStorageStrategies + "Implement new storage strategies as pair of methods, each having a <ffiPoolDataStorage: #label> pragma and <read> or <write>. Pool definitions can then point to their preferred storage strategy using the same <ffiPoolDataStorage: #label> pragma. Note that multiple storages may be considered when trying to fetch pool data for pool definitions such as if some are unavailable. See #fetchPoolData." + + | result | + result := Dictionary new. + ExternalPoolReadWriter methodsDo: [:method | + (method pragmaAt: #ffiPoolDataStorage:) ifNotNil: [:pragma | + (result at: pragma arguments first ifAbsentPut: [Dictionary new]) + at: (((method pragmaAt: #write) ifNil: [method pragmaAt: #read]) + ifNotNil: [:p | p keyword] ifNil: [#unknown]) + put: method]]. + ^ result! Item was added: + ----- Method: ExternalPoolReadWriter>>lf (in category 'writing - C generator') ----- + lf + + programGenerator + emitOutputCode: '\n' + escaped: false.! Item was added: + ----- Method: ExternalPoolReadWriter>>loadPoolData (in category 'reading - fetch/interpret/clear/load') ----- + loadPoolData + "Process the structured information present in poolData and load the actual values into the pool." + + externalPool lastDefinition: poolDefinition name.! Item was added: + ----- Method: ExternalPoolReadWriter>>nextBooleanVariableFrom: (in category 'reading - interpret platform constants') ----- + nextBooleanVariableFrom: data + + ^ self nextLiteralVariableFrom: data! Item was added: + ----- Method: ExternalPoolReadWriter>>nextCharacterVariableFrom: (in category 'reading - interpret platform constants') ----- + nextCharacterVariableFrom: data + + ^ self nextLiteralVariableFrom: data! Item was added: + ----- Method: ExternalPoolReadWriter>>nextExternalAddressVariableFrom: (in category 'reading - interpret platform constants') ----- + nextExternalAddressVariableFrom: data + "Try #Number or #ByteArray if you really want to write a pointer address into the external pool." + + self shouldNotImplement. + "^ self nextPointerVariableFrom: data"! Item was added: + ----- Method: ExternalPoolReadWriter>>nextFloatVariableFrom: (in category 'reading - interpret platform constants') ----- + nextFloatVariableFrom: data + + ^ self nextLiteralVariableFrom: data! Item was added: + ----- Method: ExternalPoolReadWriter>>nextLargePositiveIntegerVariableFrom: (in category 'reading - interpret platform constants') ----- + nextLargePositiveIntegerVariableFrom: data + + ^ self nextNumberVariableFrom: data! Item was added: + ----- Method: ExternalPoolReadWriter>>nextLiteralVariableFrom: (in category 'reading - interpret platform constants') ----- + nextLiteralVariableFrom: data + "Implement this in a read-writer to enable the #nextVariable:data: hook to shorten the implementation of #interpretPoolData. Note that this is called 'nextLiteral' instead of 'next' to mirror the serialization side in 'nextPutLiteral' -- even though this method does not have to deal with Smalltalk literals at all. 'data' could be a byte array or whatever." + + self subclassResponsibility.! Item was added: + ----- Method: ExternalPoolReadWriter>>nextNumberVariableFrom: (in category 'reading - interpret platform constants') ----- + nextNumberVariableFrom: data + + ^ self nextLiteralVariableFrom: data! Item was added: + ----- Method: ExternalPoolReadWriter>>nextPointerVariableFrom: (in category 'reading - interpret platform constants') ----- + nextPointerVariableFrom: data + + self subclassResponsibility.! Item was added: + ----- Method: ExternalPoolReadWriter>>nextPut: (in category 'writing - C generator') ----- + nextPut: aCharacter + + programGenerator emitOutputCode: aCharacter.! Item was added: + ----- Method: ExternalPoolReadWriter>>nextPutAll: (in category 'writing - C generator') ----- + nextPutAll: aString + + programGenerator emitOutputCode: aString.! Item was added: + ----- Method: ExternalPoolReadWriter>>nextPutBooleanVariable:from: (in category 'writing - serialize platform constants') ----- + nextPutBooleanVariable: aName from: anExternalType + + self nextPutLiteralVariable: aName from: anExternalType.! Item was added: + ----- Method: ExternalPoolReadWriter>>nextPutCharacterVariable:from: (in category 'writing - serialize platform constants') ----- + nextPutCharacterVariable: aName from: anExternalType + "Ensure to printf single characters as number from the platform. Interpret that to a character later." + + self assert: [(self cFormatPlaceHolderFor: anExternalType) endsWith: 'u']. + + self nextPutLiteralVariable: aName from: anExternalType. + ! Item was added: + ----- Method: ExternalPoolReadWriter>>nextPutDefinition: (in category 'writing - serialization') ----- + nextPutDefinition: aPoolDefinition + "Just for documentation. Be sure to write out platform information and variables from the pool definition. Platform information will be stored in a loaded pool for debugging purposes, i.e., to figure out on which exact platform all those pool values were collected." + + self nextPutPlatform: self platform. + + aPoolDefinition variablesAndTypesDo: [:variableName :type :compatibleName | + self + nextPutVariable: variableName + type: type key + convertTo: type value]. + + self subclassResponsibility. + self shouldBeImplemented.! Item was added: + ----- Method: ExternalPoolReadWriter>>nextPutExternalAddressVariable:from: (in category 'writing - serialize platform constants') ----- + nextPutExternalAddressVariable: aName from: anExternalType + "Try #Number or #ByteArray if you really want to write a pointer address into the external pool." + + self shouldNotImplement. + "self nextPutPointerVariable: aName from: anExternalType."! Item was added: + ----- Method: ExternalPoolReadWriter>>nextPutFloatVariable:from: (in category 'writing - serialize platform constants') ----- + nextPutFloatVariable: aName from: anExternalType + "Extra hook to distinguish large floating point numbers. Try to emit maximum precision." + + self assert: [anExternalType = ExternalType float or: [anExternalType = ExternalType double]]. + + programGenerator + emitVariableAsMaxPrecisionFloat: aName + cType: (self cTypeNameFor: anExternalType). + + "self nextPutLiteralVariable: aName from: anExternalType."! Item was added: + ----- Method: ExternalPoolReadWriter>>nextPutLargePositiveIntegerVariable:from: (in category 'writing - serialize platform constants') ----- + nextPutLargePositiveIntegerVariable: aName from: anExternalType + "Extra hook to distinguish large positive/negative numbers." + + self nextPutNumberVariable: aName from: anExternalType.! Item was added: + ----- Method: ExternalPoolReadWriter>>nextPutLineEnding (in category 'writing - C generator') ----- + nextPutLineEnding + "Use #lf as stdio-compatible line-end character. Note that this is not the line ending the C generator puts into the C file but it is the line ending of a line of content generated by that C file." + + self lf.! Item was added: + ----- Method: ExternalPoolReadWriter>>nextPutLiteralVariable:from: (in category 'writing - serialize platform constants') ----- + nextPutLiteralVariable: aName from: anExternalType + "Assume that C printf produces code that is compatible with the read-writer's serialization format." + + self assert: [anExternalType isPointerType not]. + + programGenerator + emitVariable: aName + cFormat: (self cFormatPlaceholderFor: anExternalType) + cType: (self cTypeNameFor: anExternalType).! Item was added: + ----- Method: ExternalPoolReadWriter>>nextPutNumberVariable:from: (in category 'writing - serialize platform constants') ----- + nextPutNumberVariable: aName from: anExternalType + + self nextPutLiteralVariable: aName from: anExternalType.! Item was added: + ----- Method: ExternalPoolReadWriter>>nextPutObject: (in category 'writing - serialize image constants') ----- + nextPutObject: anObject + "A read-writer can offer to serialize a plain Smalltalk object as a constant value." + + self subclassResponsibility.! Item was added: + ----- Method: ExternalPoolReadWriter>>nextPutPlatform: (in category 'writing - serialization') ----- + nextPutPlatform: aPlatform + "Serialize information about the target platform of the definition." + + self subclassResponsibility. + self shouldBeImplemented.! Item was added: + ----- Method: ExternalPoolReadWriter>>nextPutPointerVariable:from: (in category 'writing - serialize platform constants') ----- + nextPutPointerVariable: aName from: anExternalType + + self assert: [anExternalType isPointerType]. + programGenerator emitVariableAsPointerAddress: aName.! Item was added: + ----- Method: ExternalPoolReadWriter>>nextPutString: (in category 'writing - serialize image constants') ----- + nextPutString: anObject + "A read-writer can offer to serialize a Smalltalk string as a constant value." + + self subclassResponsibility.! Item was added: + ----- Method: ExternalPoolReadWriter>>nextPutStringVariable:from: (in category 'writing - serialize platform constants') ----- + nextPutStringVariable: aName from: anExternalType + + self assert: [anExternalType = ExternalType char asPointerType]. + programGenerator emitVariableAsCString: aName.! Item was added: + ----- Method: ExternalPoolReadWriter>>nextPutSymbol: (in category 'writing - serialize image constants') ----- + nextPutSymbol: anObject + "A read-writer can offer to serialize a Smalltalk symbol as a constant value." + + self subclassResponsibility.! Item was added: + ----- Method: ExternalPoolReadWriter>>nextPutSymbolVariable:from: (in category 'writing - serialize platform constants') ----- + nextPutSymbolVariable: aName from: anExternalType + + self nextPutStringVariable: aName from: anExternalType.! Item was added: + ----- Method: ExternalPoolReadWriter>>nextPutVariable:type:convertTo: (in category 'writing - serialize platform constants') ----- + nextPutVariable: aName type: anExternalType convertTo: aClass + "Most important step. Generate code for resolving the variable name and converting its value into C printf compatible output format. You might consider aClass to directly prepare (and improve) the reading process by generating more code and not relying on the pool definition object to be present at reading time. So, eventually, the user wishes to access something compatible with aClass in the external pool's variable." + + aClass == Character ifTrue: [ + ^ self nextPutCharacterVariable: aName from: anExternalType]. + aClass == String ifTrue: [ + ^ self nextPutStringVariable: aName from: anExternalType]. + aClass == Symbol ifTrue: [ + ^ self nextPutSymbolVariable: aName from: anExternalType]. + + aClass == Float ifTrue: [ + ^ self nextPutFloatVariable: aName from: anExternalType]. + (aClass includesBehavior: LargePositiveInteger) ifTrue: [ + ^ self nextPutLargePositiveIntegerVariable: aName from: anExternalType]. + + aClass == Boolean ifTrue: [ + ^ self nextPutBooleanVariable: aName from: anExternalType]. + + aClass == ExternalAddress ifTrue: [ + ^ self nextPutExternalAddressVariable: aName from: anExternalType]. + + (aClass includesBehavior: RawBitsArray) ifTrue: [ + "The C program generator has no support yet to unpack static arrays of numbers yet. Maybe you can implement it? ;-)" + self notYetImplemented]. + + "Finally, the default cases." + anExternalType isPointerType + ifTrue: [^ self nextPutPointerVariable: aName from: anExternalType] + ifFalse: [^ self nextPutNumberVariable: aName from: anExternalType].! Item was added: + ----- Method: ExternalPoolReadWriter>>nextStringVariableFrom: (in category 'reading - interpret platform constants') ----- + nextStringVariableFrom: data + + ^ self nextLiteralVariableFrom: data! Item was added: + ----- Method: ExternalPoolReadWriter>>nextSymbolVariableFrom: (in category 'reading - interpret platform constants') ----- + nextSymbolVariableFrom: data + + ^ self nextLiteralVariableFrom: data! Item was added: + ----- Method: ExternalPoolReadWriter>>nextVariable:data: (in category 'reading - interpret platform constants') ----- + nextVariable: name data: data + "Depending on the serialization format, you can use this hook to conveniently de-serialize the pool data and convert them to Smalltalk objects. Note that read-writer's that do the heavy lifting during serialization -- and thus already emitted Smalltalk code as pool data -- will not need this hook during pool-data interpretation." + + (poolDefinition variablesAndTypesAt: name) value == Character ifTrue: [ + ^ self nextCharacterVariableFrom: data]. + (poolDefinition variablesAndTypesAt: name) value == String ifTrue: [ + ^ self nextStringVariableFrom: data]. + (poolDefinition variablesAndTypesAt: name) value == Symbol ifTrue: [ + ^ self nextSymbolVariableFrom: data]. + + (poolDefinition variablesAndTypesAt: name) value == Float ifTrue: [ + ^ self nextFloatVariableFrom: data]. + ((poolDefinition variablesAndTypesAt: name) value includesBehavior: LargePositiveInteger) ifTrue: [ + ^ self nextLargePositiveIntegerVariableFrom: data]. + + (poolDefinition variablesAndTypesAt: name) value == Boolean ifTrue: [ + ^ self nextBooleanVariableFrom: data]. + + (poolDefinition variablesAndTypesAt: name) value == ExternalAddress ifTrue: [ + ^ self nextExternalAddressVariableFrom: data]. + + ((poolDefinition variablesAndTypesAt: name) value includesBehavior: RawBitsArray) ifTrue: [ + "The C program generator has no support yet to unpack static arrays of numbers yet. Maybe you can implement it? ;-)" + self notYetImplemented]. + + "Finally, the defaults." + (poolDefinition variablesAndTypesAt: name) key isPointerType + ifTrue: [^ self nextPointerVariableFrom: data] + ifFalse: [^ self nextNumberVariableFrom: data].! Item was added: + ----- Method: ExternalPoolReadWriter>>outputFileName (in category 'writing - defaults') ----- + outputFileName + ^ self id, '.data'! Item was added: + ----- Method: ExternalPoolReadWriter>>outputFilePath (in category 'writing - defaults') ----- + outputFilePath + ^ self pathToWriteTo, self outputFileName! Item was added: + ----- Method: ExternalPoolReadWriter>>pathToWriteTo (in category 'writing - defaults') ----- + pathToWriteTo + "Where to put all temporary artifacts that are created during generation, compilation, and evaluation of the C program?" + + ^ self class workingPath, 'ffi-external-pool-tmp', FileDirectory slash! Item was added: + ----- Method: ExternalPoolReadWriter>>platform (in category 'writing - defaults') ----- + platform + "Answer the platform to serialize." + + self flag: #discuss. "mt: I think it is useless to store the same platform as in the pool definition. That information is just for producing/locating the pool data. Instead, we should store the platform of the system that is *ACTUALLY PRODUCING* the pool data. Then, we could debug if some pool's values would be wrong in the shared artifacts." + + "NOT: poolDefinition platform" + ^ FFIPlatformDescription current! Item was added: + ----- Method: ExternalPoolReadWriter>>programCompilerClass (in category 'writing - defaults') ----- + programCompilerClass + + ^ (self environment classNamed: #ExternalPoolProgramCompiler) + ifNotNil: [:scope | scope defaultCompilerClass]! Item was added: + ----- Method: ExternalPoolReadWriter>>programGeneratorClass (in category 'writing - defaults') ----- + programGeneratorClass + + ^ (self environment classNamed: #ExternalPoolProgramGenerator) + ifNotNil: [:scope | scope defaultGeneratorClass]! Item was added: + ----- Method: ExternalPoolReadWriter>>readPoolData (in category 'reading') ----- + readPoolData + "Deployment time :-)" + + self fetchPoolData. + self interpretPoolData. + + self clearPoolData. "Discard old values." + self loadPoolData. "Load new values."! Item was added: + ----- Method: ExternalPoolReadWriter>>runProgramFile (in category 'writing - generate/compile/run/store') ----- + runProgramFile + "The generator has knowledge about the program's behavior. The compiler (adapter) has knowledge about how to invoke external commands. Both need to cooperate to now extract the pool data. We assume for now that the generator did not generate a shared library but a normal, executable program. We also assume thet the first parameter for that program will write the pool data into the file system." + + "Delete existing files now because it is tricky to notice the error if the program cannot write to it." + FileDirectory default deleteFileNamed: self outputFilePath. + + self flag: #refactor. "mt: Hide that #convertedFilePath: detail..." + self programCompilerClass runExternalCommand: ('{1} {2}' format: { + self programCompilerClass convertedFilePath: self compiledProgramFilePath. + self programCompilerClass convertedFilePath: self outputFilePath}).! Item was added: + ----- Method: ExternalPoolReadWriter>>setPool: (in category 'initialization') ----- + setPool: anExternalPool + "Initialize from a pool and look up the preferred definition." + + externalPool := anExternalPool. + poolDefinition := anExternalPool preferredResolvedDefinition.! Item was added: + ----- Method: ExternalPoolReadWriter>>setPoolDefinition: (in category 'initialization') ----- + setPoolDefinition: anExternalPoolDefinition + "Initialize from a specific pool definition." + + externalPool := anExternalPoolDefinition origin. + poolDefinition := anExternalPoolDefinition.! Item was added: + ----- Method: ExternalPoolReadWriter>>space (in category 'writing - C generator') ----- + space + + programGenerator + emitOutputCode: ' ' + escaped: false.! Item was added: + ----- Method: ExternalPoolReadWriter>>storageFileName (in category 'pool data storage - configuration') ----- + storageFileName + + self subclassResponsibility.! Item was added: + ----- Method: ExternalPoolReadWriter>>storageGitHubPath (in category 'pool data storage - todo') ----- + storageGitHubPath + "Idea: Configure this image to use a specific GitHub repository. Maybe package-specific dispatch. Maybe globally. Note that you can access the current pool class and thus also the package from here. So you could configure such a storage strategy *without* having to change the read/writer or even the pool definition. ;-) Maybe even re-use #storageFileName to store different serialization formats side-by-side. Or keep it simple as in #methodString storage, where different formats overwrite each other." + + self notYetImplemented.! Item was added: + ----- Method: ExternalPoolReadWriter>>storagePath (in category 'pool data storage - configuration') ----- + storagePath + + ^ self class workingPath, 'ffi-external-pool-data', FileDirectory slash! Item was added: + ----- Method: ExternalPoolReadWriter>>storageSqueakSourcePath (in category 'pool data storage - todo') ----- + storageSqueakSourcePath + "Idea: Configure this image to use a specific SqueakSource repository. Maybe package-specific dispatch. Maybe globally. Note that you can access the current pool class and thus also the package from here. So you could configure such a storage strategy *without* having to change the read/writer or even the pool definition. ;-) Maybe even re-use #storageFileName to store different serialization formats side-by-side. Or keep it simple as in #methodString storage, where different formats overwrite each other." + + self notYetImplemented.! Item was added: + ----- Method: ExternalPoolReadWriter>>storeInFile (in category 'pool data storage - strategies') ----- + storeInFile + <ffiPoolDataStorage: #file> + <write> + + FileDirectory default assureExistenceOfPath: self storagePath. + + FileStream fileNamed: self outputFilePath do: [:sourceStream | + FileStream forceNewFileNamed: self storagePath, self storageFileName do: [:targetStream | + FileDirectory default + copyFile: sourceStream + toFile: targetStream]].! Item was added: + ----- Method: ExternalPoolReadWriter>>storeInMethodSource (in category 'pool data storage - strategies') ----- + storeInMethodSource + "Note that this storage strategy only works for read-writers that serialize into valid Smalltalk code." + <ffiPoolDataStorage: #methodSource> + <write> + + | category selector source class data | + category := (externalPool theMetaClass organization categoryOfElement: poolDefinition name), ' - data'. + selector := (poolDefinition name, 'Data') asSymbol. + class := externalPool theMetaClass. + data := FileStream fileNamed: self outputFilePath do: [:sourceStream | sourceStream upToEnd]. + + source := '{1}\ "Automatically generated."\ <ffiPoolReadWriter: #{2}>\ <ffiPoolDataStorage: {6}>\ "\ {4} {5} readPoolDataFrom: {6}.\ {4} {5} writePoolDataTo: {6}.\ "\ ^ {3}' withCRs format: { + selector. self class name. data. + externalPool name. + poolDefinition name. + #methodSource storeString}. + + class + compile: source + classified: category.! Item was added: + ----- Method: ExternalPoolReadWriter>>storeInMethodSourceCompact (in category 'pool data storage - strategies') ----- + storeInMethodSourceCompact + "Note that this storage strategy only works for read-writers that serialize into valid Smalltalk code." + <ffiPoolDataStorage: #methodSourceCompact> + <write> + + | category selector source class data | + category := (externalPool theMetaClass organization categoryOfElement: poolDefinition name), ' - data'. + selector := (poolDefinition name, 'Data') asSymbol. + class := externalPool theMetaClass. + data := FileStream fileNamed: self outputFilePath do: [:sourceStream | sourceStream upToEnd]. + + source := '{1}\ "Automatically generated."\ <ffiPoolReadWriter: #{2}>\ <ffiPoolDataStorage: {6}>\ "\ {4} {5} readPoolDataFrom: {6}.\ {4} {5} writePoolDataTo: {6}.\ "\ ^ {3}' withCRs format: { + selector. self class name. (Compiler evaluate: data) storeString. + externalPool name. + poolDefinition name. + #methodSourceCompact storeString}. + + class + compile: source + classified: category.! Item was added: + ----- Method: ExternalPoolReadWriter>>storeInMethodString (in category 'pool data storage - strategies') ----- + storeInMethodString + <ffiPoolDataStorage: #methodString> + <write> + + | category selector source class data | + category := (externalPool theMetaClass organization categoryOfElement: poolDefinition name), ' - data'. + selector := (poolDefinition name, 'Data') asSymbol. + class := externalPool theMetaClass. + data := FileStream fileNamed: self outputFilePath do: [:sourceStream | sourceStream upToEnd]. + + source := '{1}\ "Automatically generated."\ <ffiPoolReadWriter: #{2}>\ <ffiPoolDataStorage: {6}>\ "\ {4} {5} readPoolDataFrom: {6}.\ {4} {5} writePoolDataTo: {6}.\ "\ ^ ''{3}''' withCRs format: { + selector. self class name. data storeString withoutQuoting. + externalPool name. + poolDefinition name. + #methodString storeString}. + + class + compile: source + classified: category.! Item was added: + ----- Method: ExternalPoolReadWriter>>storeOnGitHub (in category 'pool data storage - todo') ----- + storeOnGitHub + "Idea: Maybe it could be possible to read/write pool data from/to github.com/squeak-smalltalk/external-pools." + <ffiPoolDataStorage: #gitHub> + <write> + + self notYetImplemented.! Item was added: + ----- Method: ExternalPoolReadWriter>>storeOnSqueakSource (in category 'pool data storage - todo') ----- + storeOnSqueakSource + "Idea: Maybe it could be possible to read/write pool data from/to source.squeak.org or squeaksource.com." + <ffiPoolDataStorage: #squeakSource> + <write> + + self notYetImplemented.! Item was added: + ----- Method: ExternalPoolReadWriter>>storeProgramOutput (in category 'writing - generate/compile/run/store') ----- + storeProgramOutput + "Note that we will not try other storage strategies if the definition's preferred strategy is unavailable. Since we are at development time for external pools, the developer has to manually decide for a different strategy. Unlike in #fetchPoolData, where we try all available strategies." + + [^ self executeMethod: ((self knownStorageStrategies at: poolDefinition poolDataStorage) at: #write)] + on: Error do: [:ex | self error: ('Could not store pool data for {1} via #{2} storage : [{3}] {4} ' + format: {self id. poolDefinition poolDataStorage. ex class name. ex messageText})]! Item was added: + ----- Method: ExternalPoolReadWriter>>tab (in category 'writing - C generator') ----- + tab + + programGenerator + emitOutputCode: '\t' + escaped: false.! Item was added: + ----- Method: ExternalPoolReadWriter>>writePoolData (in category 'writing') ----- + writePoolData + "Development time :-)" + + self + generateProgramSourceFile; + compileProgramFile; + runProgramFile; + storeProgramOutput.! Item was added: + ExternalPoolSmalltalkReadWriter subclass: #ExternalPoolST1ReadWriter + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Pools'! + + !ExternalPoolST1ReadWriter commentStamp: 'mt 6/2/2020 18:52' prior: 0! + My serialization format is a literal Smalltalk array in which the first element is the platform description and the second element is a dictionary that holds all values in the external pool. + + I serialize all numbers as hexadecimal number literals for a typical Smalltalk parser. + + Here is an example of my serialization format: + + { + (FFIPlatformDescription name: 'Win32' osVersion: '10.0' subtype: 'IX86' wordSize: 4). + Dictionary new + at: #AUDIO_S32LSB put: 16r00008020; + at: #SDL_WINDOW_SHOWN put: 16r00000004; + at: #SDL_WINDOW_FULLSCREEN put: 16r00000001; + yourself. + }! Item was added: + ----- Method: ExternalPoolST1ReadWriter>>interpretPoolData (in category 'reading - fetch/interpret/clear/load') ----- + interpretPoolData + + super interpretPoolData. + + self assert: [poolData isArray]. + self assert: [poolData size = 2]. + self assert: [poolData last isDictionary].! Item was added: + ----- Method: ExternalPoolST1ReadWriter>>loadPoolData (in category 'reading - fetch/interpret/clear/load') ----- + loadPoolData + + super loadPoolData. + + externalPool lastPlatform: poolData first. + + poolData second keysAndValuesDo: [:name :value | + externalPool at: name put: value].! Item was added: + ----- Method: ExternalPoolST1ReadWriter>>nextPutDefinition: (in category 'writing - serialization') ----- + nextPutDefinition: poolDefinition + "Serialize a pool definition." + + "1) Open the literal array" + self + nextPut: ${; + nextPutLineEnding. + + "2) Store the platform description." + self + tab; + nextPutPlatform: self platform; + nextPut: $.; + nextPutLineEnding. + + "3) Store all pool variables in a dictionary." + self + tab; + nextPutAll: 'Dictionary new'; + nextPutLineEnding. + + poolDefinition variablesAndTypesDo: [:cVariable :type :poolVariable | + self + tab; tab; + nextPutAll: ('at: #{1} put: ' format: {poolVariable}); + nextPutVariable: cVariable + type: type key + convertTo: type value; + nextPut: $;; + nextPutLineEnding]. + + self + tab; tab; + nextPutAll: 'yourself'; + nextPut: $.; + nextPutLineEnding. + + "4) Close the literal array" + self + nextPut: $}; + nextPutLineEnding.! Item was added: + ----- Method: ExternalPoolST1ReadWriter>>nextPutLargePositiveIntegerVariable:from: (in category 'writing - serialize platform constants') ----- + nextPutLargePositiveIntegerVariable: aName from: anExternalType + "For very big numbers, do not use the hexadecimal format." + + super + nextPutNumberVariable: aName + from: anExternalType.! Item was added: + ----- Method: ExternalPoolST1ReadWriter>>nextPutNumberVariable:from: (in category 'writing - serialize platform constants') ----- + nextPutNumberVariable: aName from: anExternalType + "Overwritten to always produce hexadecimal output with at least 8 digits. So, 0x00008040 in the C code becomes 16r00008040 in Smalltalk code." + + "self nextPut: $)." + self nextPutAll: '16r'. + programGenerator + emitVariable: aName + cFormat: (((self cFormatPlaceholderFor: anExternalType) allButLast, 'X') copyReplaceAll: '%' with: '%08') + cType: (self cTypeNameFor: anExternalType). + "self nextPut: $)."! Item was added: + ----- Method: ExternalPoolST1ReadWriter>>nextPutPlatform: (in category 'writing - serialization') ----- + nextPutPlatform: aPlatform + + self nextPutObject: aPlatform.! Item was added: + ExternalPoolSmalltalkReadWriter subclass: #ExternalPoolST2ReadWriter + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Pools'! + + !ExternalPoolST2ReadWriter commentStamp: 'mt 6/2/2020 18:52' prior: 0! + Here is an example of my serialization format: + + { + { 'Win32'. '10.0'. 'IX86'. 4 }. + #'AUDIO_S32LSB' -> 32800. + #'SDL_WINDOW_SHOWN' -> 4. + #'SDL_WINDOW_FULLSCREEN' -> 1. + }! Item was added: + ----- Method: ExternalPoolST2ReadWriter>>interpretPoolData (in category 'reading - fetch/interpret/clear/load') ----- + interpretPoolData + + super interpretPoolData. + + self assert: [poolData isArray]. + self assert: [poolData notEmpty]. + + poolData at: 1 put: (FFIPlatformDescription + name: poolData first first + osVersion: poolData first second + subtype: poolData first third + wordSize: poolData first fourth).! Item was added: + ----- Method: ExternalPoolST2ReadWriter>>loadPoolData (in category 'reading - fetch/interpret/clear/load') ----- + loadPoolData + + super loadPoolData. + + externalPool lastPlatform: poolData first. + + poolData allButFirstDo: [:assoc | + externalPool at: assoc key put: assoc value].! Item was added: + ----- Method: ExternalPoolST2ReadWriter>>nextPutDefinition: (in category 'writing - serialization') ----- + nextPutDefinition: poolDefinition + + "1) Open the literal array" + self + nextPut: ${; + nextPutLineEnding. + + "2) Store the platform description." + self + tab; + nextPutPlatform: self platform; + nextPut: $.; + nextPutLineEnding. + + "3) Store all pool variables as associations." + poolDefinition variablesAndTypesDo: [:cVariable :type :poolVariable | + self + tab; + nextPutSymbol: poolVariable; + nextPutAll: ' -> '; + nextPutVariable: cVariable + type: type key + convertTo: type value; + nextPut: $.; + nextPutLineEnding]. + + "4) Close the literal array" + self + nextPut: $}; + nextPutLineEnding.! Item was added: + ----- Method: ExternalPoolST2ReadWriter>>nextPutPlatform: (in category 'writing - serialization') ----- + nextPutPlatform: aPlatform + "Generate a generic specification in array form." + + self + nextPut: ${; space; + nextPutString: aPlatform name; + nextPut: $.; space; + nextPutString: aPlatform osVersion; + nextPut: $.; space; + nextPutString: aPlatform subtype; + nextPut: $.; space; + nextPutAll: aPlatform wordSize asString; + space; nextPut: $}.! Item was added: + ExternalPoolReadWriter subclass: #ExternalPoolSmalltalkReadWriter + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Pools'! + + !ExternalPoolSmalltalkReadWriter commentStamp: 'mt 6/2/2020 18:50' prior: 0! + I provide support for converting Smalltalk objects from C printf interpretation of C types. + + I am abstract because I do not use my knowledge to actually write a Smalltalk-compatible serialization format for my current pool definition (or platform description). + + You can use me as a base class for developing a new read-writer that does the heavy-lifting during pool-data serialization. See the methods in 'serialize platform constants'. Note that "heavy lifting" refers to the creation of Smalltalk objects. For the fun of it, try comparing me to ExternalPoolLinesReadWriter.! Item was added: + ----- Method: ExternalPoolSmalltalkReadWriter>>ensureParsingSupport (in category 'initialization') ----- + ensureParsingSupport + + (self environment classNamed: #Compiler) ifNotNil: [:compiler | + (compiler respondsTo: #evaluate:) ifTrue: [^ self]]. + + self error: 'Hmmm.....'.! Item was added: + ----- Method: ExternalPoolSmalltalkReadWriter>>interpretPoolData (in category 'reading - fetch/interpret/clear/load') ----- + interpretPoolData + "Supports storage strategy #methodSource and #methodSourceCompact." + + poolData isString + ifTrue: [poolData := Compiler evaluate: poolData].! Item was added: + ----- Method: ExternalPoolSmalltalkReadWriter>>nextPutBooleanVariable:from: (in category 'writing - serialize platform constants') ----- + nextPutBooleanVariable: aName from: anExternalType + + super nextPutBooleanVariable: aName from: anExternalType. + self nextPutAll: ' ~= 0'.! Item was added: + ----- Method: ExternalPoolSmalltalkReadWriter>>nextPutCharacterVariable:from: (in category 'writing - serialize platform constants') ----- + nextPutCharacterVariable: aName from: anExternalType + "Convert the literal number into a character. Note that we could also prepend a single letter with $. Eventually this depends on the treatment of (signed/unsigned) char in printf format. See atomic types in ExternalType." + + super nextPutCharacterVariable: aName from: anExternalType. + self nextPutAll: ' asCharacter'.! Item was added: + ----- Method: ExternalPoolSmalltalkReadWriter>>nextPutFloatVariable:from: (in category 'writing - serialize platform constants') ----- + nextPutFloatVariable: aName from: anExternalType + "Use a class-side helper method to parse the float out of what C printf produces." + + self nextPutAll: ('({1} {2} ''' format: { + self class name. + #readFloatFrom:}). + super nextPutFloatVariable: aName from: anExternalType. + self nextPutAll: ''')'.! Item was added: + ----- Method: ExternalPoolSmalltalkReadWriter>>nextPutNumberVariable:from: (in category 'writing - serialize platform constants') ----- + nextPutNumberVariable: aName from: anExternalType + "Supports decimal, octal, and hexadecimal outputs." + + | prefix | + prefix := (self cFormatPlaceholderFor: anExternalType) last + caseOf: { + [ $o ] -> [ '8r' ]. + [ $x ] -> [ '16r' ]. + [ $X ] -> [ '16r' ] } + otherwise: [ '' ]. + + "self nextPut: $(." + prefix ifNotEmpty: [self nextPutAll: prefix]. + super nextPutNumberVariable: aName from: anExternalType. + "self nextPut: $)."! Item was added: + ----- Method: ExternalPoolSmalltalkReadWriter>>nextPutObject: (in category 'writing - serialize image constants') ----- + nextPutObject: anObject + "Write the store string of anObject, which is valid a Smalltalk." + + self nextPutAll: anObject storeString.! Item was added: + ----- Method: ExternalPoolSmalltalkReadWriter>>nextPutPointerVariable:from: (in category 'writing - serialize platform constants') ----- + nextPutPointerVariable: aName from: anExternalType + "Pointer addresses are usually hexadecimal outputs." + + self flag: #discuss. "mt: Maybe produce a byte array?" + + self nextPut: '16r'. + super nextPutPointerVariable: aName from: anExternalType.! Item was added: + ----- Method: ExternalPoolSmalltalkReadWriter>>nextPutString: (in category 'writing - serialize image constants') ----- + nextPutString: aString + "Write a Smalltalk (fixed) string literal." + + self nextPut: $'. + self nextPutAll: aString. + self nextPut: $'.! Item was added: + ----- Method: ExternalPoolSmalltalkReadWriter>>nextPutStringVariable:from: (in category 'writing - serialize platform constants') ----- + nextPutStringVariable: aName from: anExternalType + "Write a Smalltalk string literal from the variable." + + self nextPut: $'. + super nextPutStringVariable: aName from: anExternalType. + self nextPut: $'.! Item was added: + ----- Method: ExternalPoolSmalltalkReadWriter>>nextPutSymbol: (in category 'writing - serialize image constants') ----- + nextPutSymbol: aStringOrSymbol + "Write a Smalltalk (fixed) symbol literal." + + self nextPutAll: '#'''. + self nextPutAll: aStringOrSymbol. + self nextPut: $'.! Item was added: + ----- Method: ExternalPoolSmalltalkReadWriter>>nextPutSymbolVariable:from: (in category 'writing - serialize platform constants') ----- + nextPutSymbolVariable: aName from: anExternalType + "Write a Smalltalk symbol literal." + + self nextPut: $#; nextPut: $'. + super nextPutSymbolVariable: aName from: anExternalType. + self nextPut: $'.! Item was added: + ----- Method: ExternalPoolSmalltalkReadWriter>>storageFileName (in category 'pool data storage - configuration') ----- + storageFileName + "Since we output Smalltalk code, put it in an .st file." + + ^ self id, '.st'! Item was removed: - SharedPool subclass: #FFIExternalSharedPool - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-Pools'! - FFIExternalSharedPool class - instanceVariableNames: 'lastPlatform'! - - !FFIExternalSharedPool commentStamp: 'monty 4/17/2018 13:13' prior: 0! - This is a base class for FFI external SharedPools that use the output of automatically generated C programs to initialize their pool variables. - - DEFINING - - Subclasses define external shared pools with class methods containing an <ffiExternalSharedPool> pragma: - fcntlUnixDefinition - <ffiExternalSharedPool> - <ffiPlatformName: 'unix'> - <ffiCCompiler: 'gcc'> - <ffiCFlags: '-Wall -o'> - <ffiCHeaders: #('<fcntl.h>')> - <ffiVariable: #S_IRUSR type: #Integer> - <ffiVariable: #S_IWUSR type: #Integer> - <ffiVariable: #S_IRGRP type: #Integer> - <ffiVariable: #S_IROTH type: #Integer> - - PLATFORMS - - Platform specifications are optional and can vary in specificity. Supported variants are: - <ffiPlatformName:> - <ffiPlatformName:osVersion:> - <ffiPlatformName:osVersion:subtype:> - <ffiPlatformName:osVersion:subtype:wordSize:> - <ffiPlatformName:wordSize:> - - During program generation, the definition with the *most specific*, compatible platform specification is selected. Precedence of the platform values are: - platform name > osVersion > subtype > wordSize - - So if the current platform name, OS version, subtype, and word size are 'unix', 'linux-gnu', 'i686', and 4, then: - <ffiPlatformName: 'unix' wordSize: 4> - - has lower precedence than: - <ffiPlatformName: 'unix' osVersion: 'linux-gnu' subtype: 'x686'> - - and: - <ffiPlatformName: 'unix' osVersion: 'linux-gnu'> - - but has higher precedence than: - <ffiPlatformName: 'unix'> - - Definitions with specifications incompatible with the current platform, like these: - <ffiPlatformName: 'unix' wordSize: 8> "different word size" - <ffiPlatformName: 'win32'> "different platform name" - - would be ignored. - - COMPILER - - The <ffiCCompiler:>, <ffiCFlags:>, and <ffiCHeaders:> pragmas control compilation. The first two take String arguments, and the third takes an Array of header path Strings. The <ffiCFlags:> argument should end with the compiler option to specify the resulting program filename ('-o' for GCC). - - VARIABLES - - Variables are typed using <ffiVariable:type:>. The supported types are: - Integer (conversion promotes to 'long long') - Float (conversion promotes 'float' and 'double' to 'long double') - String (for C null-terminated strings) - Character (conversion promotes to 'unsigned int') - Boolean - LargePositiveInteger (conversion promotes to 'unsigned long long') - - Untyped variables are assumed to be Integers. Variables typed nil are ignored during program generation: - <ffiVariable: EAGAIN type: nil> "ignored" - - INHERITANCE - - A definition can inherit from another definition with <ffiInheritsFrom:>. For example, this OS version-specific definition inherits from the one above, changing just the platform specification and compiler flags: - fcntlPedanticUnixLinuxDefinition - <ffiExternalSharedPool> - <ffiInheritsFrom: #fcntlUnixDefinition> - <ffiPlatformName: 'unix' osVersion: 'linux-gnu'> - <ffiCFlags: '-Wall -pedantic -o'> - - GENERATING - - Use #generateProgram to generate and compile the C program. The program will output the values of the C identifiers that match the pool variable names in a Smalltalk-compatible format, which is read during reinitialization. - - Use 'self generateAllPrograms' to generate every program. - - Use #initializeFromGeneratedProgramOutput to run the program (if it hasn't been run yet), read the output file, and reinitialize the pool variables from it. - - Use 'self initializeAllFromGeneratedProgramOutput' to reinitialize all subclasses. - - Use #generateDefinitionForCurrentPlatformNameAndWordSize to generate a default definition for the current platform name and word size.! - FFIExternalSharedPool class - instanceVariableNames: 'lastPlatform'! Item was removed: - ----- Method: FFIExternalSharedPool class>>allExternalSharedPoolClassesDo: (in category 'enumerating') ----- - allExternalSharedPoolClassesDo: aBlock - "avoid #withAllSubclassesDo: to enumerate self first" - self isSkipped - ifFalse: [aBlock value: self]. - self allSubclassesDo: [:each | - each isSkipped - ifFalse: [aBlock value: each]].! Item was removed: - ----- Method: FFIExternalSharedPool class>>compileGeneratedSourceFileForDefinition: (in category 'private') ----- - compileGeneratedSourceFileForDefinition: aDefinition - self - executeExternalCommand: '{1} {2} {3} {4}' - format: - {aDefinition cCompiler. - aDefinition cFlags. - self generatedProgramPath. - self generatedSourceFilePath} - description: 'compile generated source code'! Item was removed: - ----- Method: FFIExternalSharedPool class>>declareUndeclaredClassVariableNamed: (in category 'private') ----- - declareUndeclaredClassVariableNamed: aVariableName - (self respondsTo: #addClassVarNamed:) - ifTrue: [ - "for Pharo" - self addClassVarNamed: aVariableName] - ifFalse: [ - "for Squeak" - self addClassVarName: aVariableName]! Item was removed: - ----- Method: FFIExternalSharedPool class>>defaultDefinition (in category 'accessing') ----- - defaultDefinition - "all definitions inherit directly or indirectly from this one" - - ^ self definitionClass defaultFromClass: self! Item was removed: - ----- Method: FFIExternalSharedPool class>>definitionClass (in category 'defaults') ----- - definitionClass - ^ FFIExternalSharedPoolDefinition! Item was removed: - ----- Method: FFIExternalSharedPool class>>definitionResolverClass (in category 'defaults') ----- - definitionResolverClass - ^ FFIExternalSharedPoolDefinitionResolver! Item was removed: - ----- Method: FFIExternalSharedPool class>>definitions (in category 'accessing') ----- - definitions - - | definitions | - definitions := OrderedCollection with: self defaultDefinition. - - self class methodsDo: [:each | - (self definitionClass fromMethod: each) ifNotNil: [:poolDefinition | - definitions add: poolDefinition]]. - - ^ definitions! Item was removed: - ----- Method: FFIExternalSharedPool class>>ensureDirectoryExists: (in category 'private') ----- - ensureDirectoryExists: aDirectoryPath - ^ self environment - at: #FileDirectory - ifPresent: [:fileDirectory | - "use Squeak's FileDirectory" - fileDirectory default assureExistenceOfPath: aDirectoryPath] - ifAbsent: [ - "use Pharo's FileSystem" - aDirectoryPath asFileReference ensureCreateDirectory]! Item was removed: - ----- Method: FFIExternalSharedPool class>>error: (in category 'private') ----- - error: aString - FFIExternalSharedPoolException signal: aString! Item was removed: - ----- Method: FFIExternalSharedPool class>>errorFailedCommandTo: (in category 'private') ----- - errorFailedCommandTo: aDescription - self error: 'Command executed to ', aDescription, ' failed'! Item was removed: - ----- Method: FFIExternalSharedPool class>>errorOSProcessRequiredTo: (in category 'private') ----- - errorOSProcessRequiredTo: aDescription - self error: - 'The OSProcess library is required to execute command to ', aDescription! Item was removed: - ----- Method: FFIExternalSharedPool class>>errorPreferredDefinition:sharesPlatformSpecificationWith: (in category 'private') ----- - errorPreferredDefinition: aFirstDefinition sharesPlatformSpecificationWith: aSecondDefinition - self error: - ('Definition #{1} has the same platform specifiation as #{2}. ', - 'Make one more or less platform-specific than: {3}' - format: - {aFirstDefinition name. - aSecondDefinition name. - aFirstDefinition platform})! Item was removed: - ----- Method: FFIExternalSharedPool class>>errorSavedPlatform:isNotCompatibleWith: (in category 'private') ----- - errorSavedPlatform: aSavedPlatform isNotCompatibleWith: aCurrentPlatform - self error: - ('The saved platform is incompatible with the current platform: {1} ~= {2}' - format: {aSavedPlatform. aCurrentPlatform})! Item was removed: - ----- Method: FFIExternalSharedPool class>>executeExternalCommand:description: (in category 'private') ----- - executeExternalCommand: aCommandString description: aDescription - | commandProcess | - - commandProcess := - (self environment - at: #OSProcess - ifAbsent: [self errorOSProcessRequiredTo: aDescription]) - waitForCommand: aCommandString. - commandProcess succeeded - ifFalse: [self errorFailedCommandTo: aDescription].! Item was removed: - ----- Method: FFIExternalSharedPool class>>executeExternalCommand:format:description: (in category 'private') ----- - executeExternalCommand: aString format: aCollection description: aDescription - ^ self - executeExternalCommand: (aString format: aCollection) - description: aDescription! Item was removed: - ----- Method: FFIExternalSharedPool class>>generateAllPrograms (in category 'generating') ----- - generateAllPrograms - "self generateAllPrograms" - - | currentPlatform | - - currentPlatform := self platformClass current. - self allExternalSharedPoolClassesDo: [:each | - each generateProgramForPlatform: currentPlatform].! Item was removed: - ----- Method: FFIExternalSharedPool class>>generateDefinitionForCurrentPlatformNameAndWordSize (in category 'generating') ----- - generateDefinitionForCurrentPlatformNameAndWordSize - "self generateDefinitionForCurrentPlatformNameAndWordSize - - Generates a method with a default definition for the - current platform name and word size." - - | currentPlatform defaultDefinition source | - - currentPlatform := self platformClass current. - defaultDefinition := self defaultDefinition. - source := String streamContents: [:stream | - stream nextPutAll: - ('definitionFor{1}Bit{2} - <ffiExternalSharedPool> - <ffiCCompiler: ''{3}''> - <ffiCFlags: ''{4}''> - <fiiPlatformName: ''{5}'' wordSize: {6}>' - format: - {currentPlatform wordSize * 8. - (currentPlatform name select: [:each | - each isAlphaNumeric]) capitalized. - defaultDefinition cCompiler. - defaultDefinition cFlags. - currentPlatform name. - currentPlatform wordSize}). - defaultDefinition variablesAndTypesDo: [:key :value | - stream nextPutAll: - (' - <ffiVariable: #{1} type: #{2}>' - format: {key. value})]]. - - self class - compile: source - classified: #'definitions - generated'.! Item was removed: - ----- Method: FFIExternalSharedPool class>>generateProgram (in category 'generating') ----- - generateProgram - "self generateProgram" - - self generateProgramForPlatform: self platformClass current! Item was removed: - ----- Method: FFIExternalSharedPool class>>generateProgramForPlatform: (in category 'generating') ----- - generateProgramForPlatform: aPlatform - | preferredDefinition | - - preferredDefinition := - self preferredResolvedDefinitionForPlatform: aPlatform. - - self - generateProgramSourceFileForDefinition: preferredDefinition; - compileGeneratedSourceFileForDefinition: preferredDefinition.! Item was removed: - ----- Method: FFIExternalSharedPool class>>generateProgramSourceFile (in category 'generating') ----- - generateProgramSourceFile - "self generateProgramSourceFile" - - self generateProgramSourceFileForPlatform: self platformClass current! Item was removed: - ----- Method: FFIExternalSharedPool class>>generateProgramSourceFileForDefinition: (in category 'private') ----- - generateProgramSourceFileForDefinition: aDefinition - self ensureDirectoryExists: self generatedProgramDirectory. - self - writeStreamOnNewFileAt: self generatedSourceFilePath - do: [:writeStream | - aDefinition generateProgramOn: writeStream].! Item was removed: - ----- Method: FFIExternalSharedPool class>>generateProgramSourceFileForPlatform: (in category 'generating') ----- - generateProgramSourceFileForPlatform: aPlatform - self generateProgramSourceFileForDefinition: - (self preferredResolvedDefinitionForPlatform: aPlatform)! Item was removed: - ----- Method: FFIExternalSharedPool class>>generatedProgramDirectory (in category 'defaults') ----- - generatedProgramDirectory - ^ self vmPath, 'FFIExternalSharedPools/'! Item was removed: - ----- Method: FFIExternalSharedPool class>>generatedProgramExtension (in category 'defaults') ----- - generatedProgramExtension - ^ self platformClass current isWindows - ifTrue: ['.exe'] - ifFalse: ['']! Item was removed: - ----- Method: FFIExternalSharedPool class>>generatedProgramName (in category 'defaults') ----- - generatedProgramName - ^ self name asString, self generatedProgramExtension! Item was removed: - ----- Method: FFIExternalSharedPool class>>generatedProgramPath (in category 'defaults') ----- - generatedProgramPath - ^ self generatedProgramDirectory, self generatedProgramName! Item was removed: - ----- Method: FFIExternalSharedPool class>>generatedSourceFileExtension (in category 'defaults') ----- - generatedSourceFileExtension - ^ '.c'! Item was removed: - ----- Method: FFIExternalSharedPool class>>generatedSourceFileName (in category 'defaults') ----- - generatedSourceFileName - ^ self name asString, self generatedSourceFileExtension! Item was removed: - ----- Method: FFIExternalSharedPool class>>generatedSourceFilePath (in category 'defaults') ----- - generatedSourceFilePath - ^ self generatedProgramDirectory, self generatedSourceFileName! Item was removed: - ----- Method: FFIExternalSharedPool class>>initialize (in category 'class initialization') ----- - initialize - "self initialize" - - "self initializeAllFromGeneratedProgramOutput"! Item was removed: - ----- Method: FFIExternalSharedPool class>>initializeAllFromGeneratedProgramOutput (in category 'class initialization') ----- - initializeAllFromGeneratedProgramOutput - "self initializeAllFromGeneratedProgramOutput" - - | currentPlatform | - - currentPlatform := self platformClass current. - self allExternalSharedPoolClassesDo: [:each | - each initializeFromGeneratedProgramOutputForPlatform: - currentPlatform].! Item was removed: - ----- Method: FFIExternalSharedPool class>>initializeFromGeneratedProgramOutput (in category 'class initialization') ----- - initializeFromGeneratedProgramOutput - "self initializeFromGeneratedProgramOutput" - - self initializeFromGeneratedProgramOutputForPlatform: - self platformClass current! Item was removed: - ----- Method: FFIExternalSharedPool class>>initializeFromGeneratedProgramOutputForPlatform: (in category 'class initialization') ----- - initializeFromGeneratedProgramOutputForPlatform: aPlatform - | outputArray outputPlatform outputVariableDictionary classVariableDictionary | - - outputArray := - self readAndEvaluatedGeneratedProgramOutput. - outputPlatform := outputArray first. - outputVariableDictionary := outputArray second. - - (outputPlatform isCompatibleWith: aPlatform) - ifFalse: [ - self - errorSavedPlatform: outputPlatform - isNotCompatibleWith: aPlatform]. - - classVariableDictionary := self classPool. - outputVariableDictionary keysAndValuesDo: [:key :value | - classVariableDictionary - at: key - ifAbsent: [self declareUndeclaredClassVariableNamed: key]. - classVariableDictionary - at: key - put: value]. - - self lastPlatform: aPlatform.! Item was removed: - ----- Method: FFIExternalSharedPool class>>isSkipped (in category 'testing') ----- - isSkipped - "Subclasses can override this to return true if they're abstract or just - don't support program generation or initialization for some reason" - - ^ self == FFIExternalSharedPool! Item was removed: - ----- Method: FFIExternalSharedPool class>>lastPlatform (in category 'accessing') ----- - lastPlatform - ^ lastPlatform! Item was removed: - ----- Method: FFIExternalSharedPool class>>lastPlatform: (in category 'accessing') ----- - lastPlatform: aPlatform - lastPlatform := aPlatform! Item was removed: - ----- Method: FFIExternalSharedPool class>>outputFileExtension (in category 'defaults') ----- - outputFileExtension - ^ '.st'! Item was removed: - ----- Method: FFIExternalSharedPool class>>outputFileName (in category 'defaults') ----- - outputFileName - ^ self name asString, self outputFileExtension! Item was removed: - ----- Method: FFIExternalSharedPool class>>outputFilePath (in category 'defaults') ----- - outputFilePath - ^ self generatedProgramDirectory, self outputFileName! Item was removed: - ----- Method: FFIExternalSharedPool class>>platformChangedFrom:to: (in category 'system startup') ----- - platformChangedFrom: lastPlatform to: currentPlatform - - self allExternalSharedPoolClassesDo: [:each | - each initializeFromGeneratedProgramOutputForPlatform: currentPlatform].! Item was removed: - ----- Method: FFIExternalSharedPool class>>platformClass (in category 'defaults') ----- - platformClass - ^ FFIPlatformDescription! Item was removed: - ----- Method: FFIExternalSharedPool class>>poolDefinition (in category 'accessing') ----- - poolDefinition - "For convenience. Answer the result of this call in definition methods to support debugging." - - thisContext sender method ifNotNil: [:poolDefinitionMethod | - (self definitionClass fromMethod: poolDefinitionMethod) - ifNotNil: [:poolDefinition | ^ poolDefinition]]. - - self error: 'Sender is no valid pool definition!!'.! Item was removed: - ----- Method: FFIExternalSharedPool class>>preferredResolvedDefinitionForPlatform: (in category 'accessing') ----- - preferredResolvedDefinitionForPlatform: aPlatform - | compatibleResolvedDefinitions | - - compatibleResolvedDefinitions := - self resolvedDefinitions select: [:each | - each platform isCompatibleWith: aPlatform]. - - compatibleResolvedDefinitions sort: [:a :b | - a isMorePlatformSpecificThan: b]. - (compatibleResolvedDefinitions size = 1 - or: [ - compatibleResolvedDefinitions first isMorePlatformSpecificThan: - compatibleResolvedDefinitions second]) - ifFalse: [ - self - errorPreferredDefinition: - compatibleResolvedDefinitions first - sharesPlatformSpecificationWith: - compatibleResolvedDefinitions second]. - - ^ compatibleResolvedDefinitions first.! Item was removed: - ----- Method: FFIExternalSharedPool class>>readAndEvaluatedGeneratedProgramOutput (in category 'reading') ----- - readAndEvaluatedGeneratedProgramOutput - | generatedProgramOutput | - - generatedProgramOutput := - [self readGeneratedProgramOutput] - on: FileDoesNotExistException - do: [:error | nil]. - "try again, this time running the program first to create the output file" - generatedProgramOutput - ifNil: [ - generatedProgramOutput := - self - runGeneratedProgram; - readGeneratedProgramOutput]. - - ^ self compilerClass evaluate: generatedProgramOutput.! Item was removed: - ----- Method: FFIExternalSharedPool class>>readGeneratedProgramOutput (in category 'private') ----- - readGeneratedProgramOutput - ^ self - readStreamOnExistingFileAt: self outputFilePath - do: [:readStream | - readStream upToEnd]! Item was removed: - ----- Method: FFIExternalSharedPool class>>readStreamOnExistingFileAt:do: (in category 'private') ----- - readStreamOnExistingFileAt: aPathString do: aBlock - | readStream | - - readStream := StandardFileStream readOnlyFileNamed: aPathString. - ^ [ - readStream ascii. - aBlock value: readStream] - ensure: [readStream close].! Item was removed: - ----- Method: FFIExternalSharedPool class>>resolvedDefinitions (in category 'accessing') ----- - resolvedDefinitions - ^ self resolvedDefinitions: self definitions! Item was removed: - ----- Method: FFIExternalSharedPool class>>resolvedDefinitions: (in category 'accessing') ----- - resolvedDefinitions: aDefinitionCollection - ^ (self definitionResolverClass - class: self - definitions: aDefinitionCollection) resolvedDefinitions! Item was removed: - ----- Method: FFIExternalSharedPool class>>runGeneratedProgram (in category 'running') ----- - runGeneratedProgram - "self runGeneratedProgram" - - self - executeExternalCommand: 'cd {1}; ./{2} {3}' - format: - {self generatedProgramDirectory. - self generatedProgramName. - self outputFilePath} - description: 'run generated program'! Item was removed: - ----- Method: FFIExternalSharedPool class>>vmPath (in category 'defaults') ----- - vmPath - ^ (Smalltalk respondsTo: #vmPath) - ifTrue: [ - "for Squeak" - Smalltalk vmPath] - ifFalse: [ - "for Pharo" - Smalltalk vm path]! Item was removed: - ----- Method: FFIExternalSharedPool class>>writeStreamOnNewFileAt:do: (in category 'private') ----- - writeStreamOnNewFileAt: aPathString do: aBlock - | writeStream | - - "use #forceNewFileNamed: to ensure truncation of existing files before writing" - writeStream := StandardFileStream forceNewFileNamed: aPathString. - ^ [ - writeStream ascii. - aBlock value: writeStream] - ensure: [writeStream close].! Item was removed: - Object subclass: #FFIExternalSharedPoolDefinition - instanceVariableNames: 'name inheritsFrom variablesAndTypes platform cFlags cCompiler cHeaders programGeneratorClass' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-Pools'! - - !FFIExternalSharedPoolDefinition commentStamp: 'monty 4/17/2018 13:07' prior: 0! - This class stores parsed FFIExternalSharedPool definitions. It can inherit from another definition with #inheritFromDefinition:, and generate a program with #generateProgramOn:. - - The supported pragmas for methods defining FFIExternalSharedPools are in the "pragmas" category.! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition class>>defaultCCompiler (in category 'defaults') ----- - defaultCCompiler - ^ self platformClass current isWindows - ifTrue: ['cl'] - ifFalse: ['cc']! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition class>>defaultCFlags (in category 'defaults') ----- - defaultCFlags - ^ self platformClass current isWindows - ifTrue: ['/out:'] - ifFalse: ['-o']! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition class>>defaultCHeaders (in category 'defaults') ----- - defaultCHeaders - ^ #()! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition class>>defaultFromClass: (in category 'instance creation') ----- - defaultFromClass: aClass - | definition | - - (definition := self new) - cCompiler: self defaultCCompiler; - cFlags: self defaultCFlags; - cHeaders: self defaultCHeaders; - platform: self defaultPlatform; - programGeneratorClass: self defaultProgramGeneratorClass. - - aClass classPool keysDo: [:each | - definition - variablesAndTypesAt: each - put: self defaultVariableType]. - - ^ definition.! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition class>>defaultPlatform (in category 'defaults') ----- - defaultPlatform - ^ self platformClass empty! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition class>>defaultProgramGeneratorClass (in category 'defaults') ----- - defaultProgramGeneratorClass - ^ FFIExternalSharedPoolProgramGenerator! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition class>>defaultVariableType (in category 'defaults') ----- - defaultVariableType - ^ Integer! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition class>>fromMethod: (in category 'instance creation') ----- - fromMethod: aCompiledMethod - | definition | - - (aCompiledMethod pragmaAt: #ffiExternalSharedPool) - ifNil: [^ nil]. - - definition := self name: aCompiledMethod selector. - - "Squeak does not have #pragmasDo:" - aCompiledMethod pragmas do: [:each | - (self whichCategoryIncludesSelector: each keyword) == #'pragmas' - ifTrue: [ - definition - perform: each keyword - withArguments: each arguments]]. - - ^ definition.! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition class>>name: (in category 'instance creation') ----- - name: aSelector - ^ self new name: aSelector! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition class>>platformClass (in category 'defaults') ----- - platformClass - ^ FFIPlatformDescription! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition>>cCompiler (in category 'accessing') ----- - cCompiler - ^ cCompiler ifNil: [cCompiler := '']! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition>>cCompiler: (in category 'accessing') ----- - cCompiler: aStringOrNil - cCompiler := - aStringOrNil - ifNotNil: [aStringOrNil asString]! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition>>cFlags (in category 'accessing') ----- - cFlags - ^ cFlags ifNil: [cFlags := '']! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition>>cFlags: (in category 'accessing') ----- - cFlags: aStringOrNil - cFlags := - aStringOrNil - ifNotNil: [aStringOrNil asString]! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition>>cHeaders (in category 'accessing') ----- - cHeaders - ^ cHeaders ifNil: [cHeaders := #()]! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition>>cHeaders: (in category 'accessing') ----- - cHeaders: aHeaderPathCollection - cHeaders := - aHeaderPathCollection asArray - select: [:each | each notEmpty] - thenCollect: [:each | | header | - header := each asString. - (header first == $" - or: [header first == $<]) - ifTrue: [header] - ifFalse: ['<', header, '>']]! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition>>cHeadersDo: (in category 'enumerating') ----- - cHeadersDo: aBlock - self cHeaders do: aBlock! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition>>ffiCCompiler: (in category 'pragmas') ----- - ffiCCompiler: aString - self cCompiler: aString! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition>>ffiCFlags: (in category 'pragmas') ----- - ffiCFlags: aString - self cFlags: aString! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition>>ffiCHeaders: (in category 'pragmas') ----- - ffiCHeaders: aHeaderPathCollection - self cHeaders: aHeaderPathCollection! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition>>ffiExternalSharedPool (in category 'pragmas') ----- - ffiExternalSharedPool - "this pragma identifies a method as defining an external shared pool"! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition>>ffiInheritsFrom: (in category 'pragmas') ----- - ffiInheritsFrom: aSelector - self inheritsFrom: aSelector! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition>>ffiPlatformName: (in category 'pragmas') ----- - ffiPlatformName: aName - self platform: - (self platformClass name: aName)! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition>>ffiPlatformName:osVersion: (in category 'pragmas') ----- - ffiPlatformName: aName osVersion: anOSVersionString - self platform: - (self platformClass - name: aName - osVersion: anOSVersionString)! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition>>ffiPlatformName:osVersion:subtype: (in category 'pragmas') ----- - ffiPlatformName: aName osVersion: anOSVersionString subtype: aSubtypeString - self platform: - (self platformClass - name: aName - osVersion: anOSVersionString - subtype: aSubtypeString)! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition>>ffiPlatformName:osVersion:subtype:wordSize: (in category 'pragmas') ----- - ffiPlatformName: aName osVersion: anOSVersionString subtype: aSubtypeString wordSize: aWordSize - self platform: - (self platformClass - name: aName - osVersion: anOSVersionString - subtype: aSubtypeString - wordSize: aWordSize)! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition>>ffiPlatformName:wordSize: (in category 'pragmas') ----- - ffiPlatformName: aName wordSize: aWordSize - self platform: - (self platformClass - name: aName - wordSize: aWordSize)! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition>>ffiProgramGenerator: (in category 'pragmas') ----- - ffiProgramGenerator: aClassName - self programGeneratorClass: aClassName! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition>>ffiVariable:type: (in category 'pragmas') ----- - ffiVariable: aVariableName type: aType - self - variablesAndTypesAt: aVariableName - put: aType! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition>>generateProgramOn: (in category 'generating') ----- - generateProgramOn: aStream - (self programGeneratorClass - on: aStream - definition: self) generate! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition>>inheritFromDefinition: (in category 'inheriting') ----- - inheritFromDefinition: aDefinition - self cCompiler - ifEmpty: [self cCompiler: aDefinition cCompiler]. - self cFlags - ifEmpty: [self cFlags: aDefinition cFlags]. - self cHeaders - ifEmpty: [self cHeaders: aDefinition cHeaders]. - self platform - ifNil: [self platform: aDefinition platform]. - self programGeneratorClass - ifNil: [self programGeneratorClass: aDefinition programGeneratorClass]. - - aDefinition variablesAndTypesDo: [:key :value | - self - variablesAndTypesAt: key - ifAbsentPut: value].! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition>>inheritsFrom (in category 'accessing') ----- - inheritsFrom - ^ inheritsFrom! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition>>inheritsFrom: (in category 'accessing') ----- - inheritsFrom: aSelectorOrNil - inheritsFrom := - aSelectorOrNil - ifNotNil: [aSelectorOrNil asSymbol]! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition>>isDefault (in category 'testing') ----- - isDefault - ^ self name isNil! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition>>isMorePlatformSpecificThan: (in category 'testing') ----- - isMorePlatformSpecificThan: aDefinition - ^ aDefinition isDefault - or: [self platform isMoreSpecificThan: aDefinition platform]! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition>>name (in category 'accessing') ----- - name - ^ name! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition>>name: (in category 'accessing') ----- - name: aSelectorOrNil - name := - aSelectorOrNil - ifNotNil: [aSelectorOrNil asSymbol]! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition>>platform (in category 'accessing') ----- - platform - ^ platform! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition>>platform: (in category 'accessing') ----- - platform: aPlatform - platform := aPlatform! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition>>platformClass (in category 'defaults') ----- - platformClass - ^ self class platformClass! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition>>printOn: (in category 'printing') ----- - printOn: aStream - super printOn: aStream. - - aStream nextPut: $(. - self isDefault - ifTrue: [aStream nextPutAll: 'default'] - ifFalse: [aStream print: self name]. - aStream nextPut: $).! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition>>programGeneratorClass (in category 'accessing') ----- - programGeneratorClass - ^ programGeneratorClass! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition>>programGeneratorClass: (in category 'accessing') ----- - programGeneratorClass: aClassOrClassName - programGeneratorClass := - aClassOrClassName isBehavior - ifTrue: [aClassOrClassName] - ifFalse: [self class environment at: aClassOrClassName asSymbol]! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition>>variablesAndTypes (in category 'accessing') ----- - variablesAndTypes - ^ variablesAndTypes ifNil: [variablesAndTypes := Dictionary new]! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition>>variablesAndTypes: (in category 'accessing') ----- - variablesAndTypes: anAssociationCollection - variablesAndTypes := Dictionary new. - anAssociationCollection associationsDo: [:each | - self - variablesAndTypesAt: each key - put: each value].! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition>>variablesAndTypesAt: (in category 'accessing') ----- - variablesAndTypesAt: aVariableName - ^ self - variablesAndTypesAt: aVariableName - ifAbsent: [nil]! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition>>variablesAndTypesAt:ifAbsent: (in category 'accessing') ----- - variablesAndTypesAt: aVariableName ifAbsent: aBlock - ^ self variablesAndTypes - at: aVariableName asSymbol - ifAbsent: aBlock! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition>>variablesAndTypesAt:ifAbsentPut: (in category 'accessing') ----- - variablesAndTypesAt: aVariableName ifAbsentPut: aBlock - ^ self - variablesAndTypesAt: aVariableName - ifAbsent: [ - self - variablesAndTypesAt: aVariableName - put: aBlock value]! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition>>variablesAndTypesAt:put: (in category 'accessing') ----- - variablesAndTypesAt: aVariableName put: aClassOrNil - ^ self variablesAndTypes - at: aVariableName asSymbol - put: aClassOrNil asFFIExternalSharedPoolType! Item was removed: - ----- Method: FFIExternalSharedPoolDefinition>>variablesAndTypesDo: (in category 'enumerating') ----- - variablesAndTypesDo: aTwoArgumentBlock - self variablesAndTypes keysAndValuesDo: aTwoArgumentBlock! Item was removed: - Object subclass: #FFIExternalSharedPoolDefinitionResolver - instanceVariableNames: 'class definitions defaultDefinition definitionsByName unresolvedDefinitions visitedDefinitions' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-Pools'! - - !FFIExternalSharedPoolDefinitionResolver commentStamp: 'monty 3/30/2018 02:01' prior: 0! - This class resolves FFIExternalSharedPoolDefinition inheritance dependencies.! Item was removed: - ----- Method: FFIExternalSharedPoolDefinitionResolver class>>class:definitions: (in category 'instance creation') ----- - class: aClass definitions: aDefinitionCollection - ^ self new - setClass: aClass - definitions: aDefinitionCollection! Item was removed: - ----- Method: FFIExternalSharedPoolDefinitionResolver>>error: (in category 'private') ----- - error: aString - FFIExternalSharedPoolException signal: aString! Item was removed: - ----- Method: FFIExternalSharedPoolDefinitionResolver>>errorLoopInDefinitions (in category 'private') ----- - errorLoopInDefinitions - self error: 'Class ', class name asString, ' has a loop in its definitions'! Item was removed: - ----- Method: FFIExternalSharedPoolDefinitionResolver>>errorUnknownReferenceInDefinition: (in category 'private') ----- - errorUnknownReferenceInDefinition: aDefinition - self error: - ('Unknown reference to definition #{1} in definition #{2} from class {3}' - format: {aDefinition inheritsFrom. aDefinition name. class name})! Item was removed: - ----- Method: FFIExternalSharedPoolDefinitionResolver>>resolveDefinition: (in category 'private') ----- - resolveDefinition: aDefinition - aDefinition inheritsFrom - ifNil: [aDefinition inheritFromDefinition: defaultDefinition] - ifNotNil: [:inheritsFrom | | inheritedDefinition | - inheritedDefinition := - definitionsByName - at: inheritsFrom - ifAbsent: [self errorUnknownReferenceInDefinition: aDefinition]. - - (visitedDefinitions includes: inheritedDefinition) - ifTrue: [self errorLoopInDefinitions]. - visitedDefinitions add: inheritedDefinition. - - (unresolvedDefinitions includes: inheritedDefinition) - ifTrue: [self resolveDefinition: inheritedDefinition]. - - aDefinition inheritFromDefinition: inheritedDefinition]. - - unresolvedDefinitions remove: aDefinition.! Item was removed: - ----- Method: FFIExternalSharedPoolDefinitionResolver>>resolvedDefinitions (in category 'accessing') ----- - resolvedDefinitions - [unresolvedDefinitions isEmpty] - whileFalse: [| definition | - definition := unresolvedDefinitions anyOne. - visitedDefinitions := Set with: definition. - self resolveDefinition: definition]. - - ^ definitions.! Item was removed: - ----- Method: FFIExternalSharedPoolDefinitionResolver>>setClass:definitions: (in category 'initialization') ----- - setClass: aClass definitions: aDefinitionCollection - class := aClass. - definitions := aDefinitionCollection. - definitionsByName := Dictionary new. - unresolvedDefinitions := Set new. - definitions do: [:each | - each isDefault - ifTrue: [defaultDefinition := each] - ifFalse: [ - definitionsByName - at: each name - put: each. - unresolvedDefinitions add: each]].! Item was removed: - Error subclass: #FFIExternalSharedPoolException - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-Pools'! - - !FFIExternalSharedPoolException commentStamp: 'monty 4/3/2018 07:25' prior: 0! - This is an exception class for all FFIExternalSharedPool errors. Any new exception classes added will be subclasses of this one.! Item was removed: - Object subclass: #FFIExternalSharedPoolProgramGenerator - instanceVariableNames: 'stream definition lineEnding' - classVariableNames: 'CRCharacter LFCharacter' - poolDictionaries: '' - category: 'FFI-Pools'! - - !FFIExternalSharedPoolProgramGenerator commentStamp: 'monty 4/1/2018 17:57' prior: 0! - This class generates a C program for an FFIExternalSharedPoolDefinition that outputs the values of C identifiers corresponding to FFIExternalSharedPool variables in a Smalltalk-compatible format for class reinitialization.! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator class>>initialize (in category 'class initialization') ----- - initialize - "self initialize" - - CRCharacter := Character cr. - LFCharacter := Character lf.! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator class>>new (in category 'instance creation') ----- - new - self shouldNotImplement! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator class>>on:definition: (in category 'instance creation') ----- - on: aStream definition: aDefinition - ^ self basicNew initialize - setStream: aStream - definition: aDefinition ! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>contents (in category 'accessing') ----- - contents - ^ self stream contents! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>defaultHeaders (in category 'defaults') ----- - defaultHeaders - ^ #('<errno.h>' '<stdarg.h>' '<stddef.h>' '<stdio.h>' '<stdlib.h>' '<string.h>')! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>defaultLineEndingForPlatform: (in category 'defaults') ----- - defaultLineEndingForPlatform: aPlatform - ^ aPlatform isWindows - ifTrue: [String crlf] - ifFalse: [String lf]! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>definition (in category 'accessing') ----- - definition - ^ definition! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>emit: (in category 'emitting') ----- - emit: aCharacter - (aCharacter == CRCharacter - or: [aCharacter == LFCharacter]) - ifTrue: [self stream nextPutAll: self lineEnding] - ifFalse: [self stream nextPut: aCharacter]! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>emitAll: (in category 'emitting') ----- - emitAll: aString - 1 to: aString size do: [:i | - self emit: (aString at: i)]! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>emitAll:format: (in category 'emitting') ----- - emitAll: aTemplateString format: aSequenceableCollectionOrDictionary - "works similar to String>>#format:, except it uses '${xxx}' syntax - for macro expansion, which is more convenient for C" - - | templateReadStream | - - templateReadStream := aTemplateString asString readStream. - [templateReadStream atEnd] - whileFalse: [| nextChar | - ((nextChar := templateReadStream next) == $$ - and: [templateReadStream peekFor: ${]) - ifTrue: [| key | - key := templateReadStream upTo: $}. - self emitAll: - (aSequenceableCollectionOrDictionary at: - (aSequenceableCollectionOrDictionary isDictionary - ifTrue: [key] - ifFalse: [key asUnsignedInteger])) asString] - ifFalse: [self emit: nextChar]].! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>emitBooleanOutputCodeFor: (in category 'emitting - output code') ----- - emitBooleanOutputCodeFor: anIdentifier - self - emitAll: '${1}(file, "(%s)", (${2} ? "true" : "false"))' - format: {self printfFunctionName. anIdentifier}! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>emitCharacterOutputCodeFor: (in category 'emitting - output code') ----- - emitCharacterOutputCodeFor: anIdentifier - self - emitAll: '${1}(file, "(%u asCharacter)", (unsigned int) ${2})' - format: {self printfFunctionName. anIdentifier}! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>emitDefaultHeaders (in category 'emitting - headers') ----- - emitDefaultHeaders - self defaultHeaders do: [:each | - self emitHeader: each]! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>emitDefinitionHeaders (in category 'emitting - headers') ----- - emitDefinitionHeaders - self definition cHeadersDo: [:each | - self emitHeader: each]! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>emitEndMainFunctionDefinition (in category 'emitting - function definitions') ----- - emitEndMainFunctionDefinition - self - emitAll: - ' - if (fflush(file) !!= 0) { - ${1}("Can''t flush file", errno); - return EXIT_FAILURE; - } - if (file !!= stdout) { - if (fclose(file) !!= 0) { - ${1}("Can''t close file", errno); - return EXIT_FAILURE; - } - } - - return EXIT_SUCCESS; - } - ' - format: {self errorFunctionName}! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>emitEndOutputCode (in category 'emitting - output code') ----- - emitEndOutputCode - self - emitAll: - ' ${1}(file, "}\n"); - ' - format: {self printfFunctionName} - ! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>emitEpilog (in category 'emitting') ----- - emitEpilog - self emitEndMainFunctionDefinition! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>emitErrorFunctionDefinition (in category 'emitting - function definitions') ----- - emitErrorFunctionDefinition - self - emitAll: ' - static void ${1}(const char *message, int error) - { - fprintf(stderr, "%s: %s\n", message, strerror(error)); - ${2} - } - ' - format: { - self errorFunctionName. - self generatedProgramExitsOnError - ifTrue: ['exit(EXIT_FAILURE);'] - ifFalse: ['/* no exit on error */']}! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>emitFileComment (in category 'emitting') ----- - emitFileComment - self - emitAll: '/* - * This file was automatically generated by ${1}. - * ''${2}'' - * ''${3}'' - */ - - ' - format: - {self class name. DateAndTime now. Smalltalk version copyWithout: $*}! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>emitFloatOutputCodeFor: (in category 'emitting - output code') ----- - emitFloatOutputCodeFor: anIdentifier - self - emitAll: '${1}(file, "(Float ffiExternalSharedPoolReadFrom: ''%Lg'')", (long double) ${2})' - format: {self printfFunctionName. anIdentifier}! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>emitFunctionDefinitions (in category 'emitting - function definitions') ----- - emitFunctionDefinitions - self - emitErrorFunctionDefinition; - emitPrintfFunctionDefinition; - emitPutcFunctionDefinition; - emitStringOutputFunctionDefinition! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>emitHeader: (in category 'emitting - headers') ----- - emitHeader: aHeaderPath - self - emitAll: '#include ${1} - ' - format: {aHeaderPath}! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>emitHeaders (in category 'emitting - headers') ----- - emitHeaders - self - emitDefaultHeaders; - emitLineEnding; - emitDefinitionHeaders! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>emitIntegerOutputCodeFor: (in category 'emitting - output code') ----- - emitIntegerOutputCodeFor: anIdentifier - self - emitAll: '${1}(file, "(%lld)", (long long) ${2})' - format: {self printfFunctionName. anIdentifier}! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>emitLineEnding (in category 'emitting') ----- - emitLineEnding - self stream nextPutAll: self lineEnding! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>emitOutputCode (in category 'emitting - output code') ----- - emitOutputCode - self - emitStartOutputCode; - emitPlatformOutputCode; - emitVariableOutputCode; - emitEndOutputCode! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>emitPlatformOutputCode (in category 'emitting - output code') ----- - emitPlatformOutputCode - self - emitAll: - ' ${1}(file, "\t%s.\n", - ' - format: {self printfFunctionName}. - "serialize the store string as a C string literal with proper escaping" - self - emitStringLiteral: self definition platform storeString; - emitAll: '); - '. - ! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>emitPrintfFunctionDefinition (in category 'emitting - function definitions') ----- - emitPrintfFunctionDefinition - self - emitAll: ' - static int ${1}(FILE *file, const char *format, ...) - { - va_list ap; - int rv; - - va_start(ap, format); - if ((rv = vfprintf(file, format, ap)) >= 0) { - va_end(ap); - } else { - int err = errno; /* save errno */ - va_end(ap); - ${2}("Can''t print to file", err); - } - - return rv; - } - ' - format: {self printfFunctionName. self errorFunctionName}! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>emitProlog (in category 'emitting') ----- - emitProlog - self - emitFileComment; - emitHeaders; - emitFunctionDefinitions; - emitStartMainFunctionDefinition! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>emitPutcFunctionDefinition (in category 'emitting - function definitions') ----- - emitPutcFunctionDefinition - self - emitAll: ' - static int ${1}(int c, FILE *file) - { - int rv; - - if ((rv = fputc(c, file)) == EOF) - ${2}("Can''t print to file", errno); - - return rv; - } - ' - format: {self putcFunctionName. self errorFunctionName}! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>emitStartMainFunctionDefinition (in category 'emitting - function definitions') ----- - emitStartMainFunctionDefinition - self - emitAll: ' - int main(int argc, char *argv[]) - { - FILE *file; - - if (argc > 1) { - if ((file = fopen(argv[1], "wb")) == NULL) { - ${1}("Can''t open file", errno); - return EXIT_FAILURE; - } - } else { - file = stdout; - } - - ' - format: {self errorFunctionName}! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>emitStartOutputCode (in category 'emitting - output code') ----- - emitStartOutputCode - self - emitAll: - ' ${1}(file, "{\n"); - ' - format: {self printfFunctionName}! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>emitStringLiteral: (in category 'emitting') ----- - emitStringLiteral: aString - self emit: $". - aString do: [:each | - (each == $" - or: [each == $\]) - ifTrue: [self emit: $\]. - self emit: each]. - self emit: $".! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>emitStringOutputCodeFor: (in category 'emitting - output code') ----- - emitStringOutputCodeFor: anIdentifier - self - emitAll: '${1}(file, ${2})' - format: {self stringOutputFunctionName. anIdentifier}! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>emitStringOutputFunctionDefinition (in category 'emitting - function definitions') ----- - emitStringOutputFunctionDefinition - self - emitAll: ' - static void ${1}(FILE *file, const char *s) - { - ${2}(file, "(''"); - while (*s !!= ''\0'') { - if (*s == ''\'''') - ${3}(''\'''', file); /* escape the subquote */ - ${3}(*s++, file); - } - ${2}(file, "'')"); - } - ' - format: - {self stringOutputFunctionName. - self printfFunctionName. - self putcFunctionName}! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>emitUnsignedIntegerOutputCodeFor: (in category 'emitting - output code') ----- - emitUnsignedIntegerOutputCodeFor: anIdentifier - self - emitAll: '${1}(file, "(%llu)", (unsigned long long) ${2})' - format: {self printfFunctionName. anIdentifier}! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>emitVariableOutputCode (in category 'emitting - output code') ----- - emitVariableOutputCode - | emittedVariableOutputCode | - - self - emitAll: - ' ${1}(file, "\tDictionary new\n"); - ' - format: {self printfFunctionName}. - - emittedVariableOutputCode := false. - self definition variablesAndTypesDo: [:key :value | - value - ifNotNil: [ - self - emitVariableOutputCodeFor: key - type: value. - emittedVariableOutputCode := true]]. - - emittedVariableOutputCode - ifTrue: [ - self - emitAll: - ' ${1}(file, "\t\tyourself\n"); - ' - format: {self printfFunctionName}].! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>emitVariableOutputCodeFor:type: (in category 'emitting - output code') ----- - emitVariableOutputCodeFor: aVariableName type: aType - self - emitAll: - ' ${1}(file, "\t\tat: #%s put: ", "${2}"); - ' - format: {self printfFunctionName. aVariableName}. - - aType - ffiExternalSharedPoolGenerateOutputCodeFor: aVariableName - with: self. - - self - emitAll: - '; - ${1}(file, ";\n"); - ' - format: {self printfFunctionName}.! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>errorFunctionName (in category 'defaults') ----- - errorFunctionName - ^ self functionNamed: 'Error'! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>functionNamed: (in category 'defaults') ----- - functionNamed: aPartialFunctionName - ^ self functionNamespace, aPartialFunctionName! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>functionNamespace (in category 'defaults') ----- - functionNamespace - ^ 'ffiExternalSharedPool'! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>generate (in category 'generating') ----- - generate - self - emitProlog; - emitOutputCode; - emitEpilog! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>generatedProgramExitsOnError (in category 'testing') ----- - generatedProgramExitsOnError - ^ true! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>lineEnding (in category 'accessing') ----- - lineEnding - ^ lineEnding! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>lineEnding: (in category 'accessing') ----- - lineEnding: aCharacterOrString - lineEnding := aCharacterOrString asString! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>printfFunctionName (in category 'defaults') ----- - printfFunctionName - ^ self functionNamed: 'Printf'! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>putcFunctionName (in category 'defaults') ----- - putcFunctionName - ^ self functionNamed: 'Putc'! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>setStream:definition: (in category 'initialization') ----- - setStream: aStream definition: aDefinition - stream := aStream. - definition := aDefinition. - lineEnding := self defaultLineEndingForPlatform: definition platform.! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>stream (in category 'accessing') ----- - stream - ^ stream! Item was removed: - ----- Method: FFIExternalSharedPoolProgramGenerator>>stringOutputFunctionName (in category 'defaults') ----- - stringOutputFunctionName - ^ self functionNamed: 'OutputString'! Item was removed: - ----- Method: Float class>>ffiExternalSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- - ffiExternalSharedPoolGenerateOutputCodeFor: aVariableName with: aProgramGenerator - aProgramGenerator emitFloatOutputCodeFor: aVariableName! Item was removed: - ----- Method: Float class>>ffiExternalSharedPoolReadFrom: (in category '*FFI-Pools') ----- - ffiExternalSharedPoolReadFrom: aStreamOrString - ^ self - ffiExternalSharedPoolReadFrom: aStreamOrString - ifFail: [nil]! Item was removed: - ----- Method: Float class>>ffiExternalSharedPoolReadFrom:ifFail: (in category '*FFI-Pools') ----- - ffiExternalSharedPoolReadFrom: aStreamOrString ifFail: aBlock - "This method is a wrapper around #readFrom:ifFail: that adds support - for C's printf() printed float representations of nan and +/- infinity" - - | readStream startPosition isNegative | - - readStream := - aStreamOrString isStream - ifTrue: [aStreamOrString] - ifFalse: [aStreamOrString readStream]. - startPosition := readStream position. - - (isNegative := readStream peekFor: $-) - ifFalse: [readStream peekFor: $+]. - - ((readStream nextMatchAll: 'infinity') - or: [(readStream nextMatchAll: 'INFINITY') - or: [(readStream nextMatchAll: 'inf') - or: [(readStream nextMatchAll: 'INF')]]]) - ifTrue: [ - ^ isNegative - ifTrue: [self negativeInfinity] - ifFalse: [self infinity]]. - - ((readStream nextMatchAll: 'nan') - or: [readStream nextMatchAll: 'NAN']) - ifTrue: [^ self nan]. - - readStream position: startPosition. - ^ self - readFrom: readStream - ifFail: aBlock.! Item was removed: - ----- Method: Integer class>>ffiExternalSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- - ffiExternalSharedPoolGenerateOutputCodeFor: aVariableName with: aProgramGenerator - aProgramGenerator emitIntegerOutputCodeFor: aVariableName! Item was removed: - ----- Method: LargePositiveInteger class>>ffiExternalSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- - ffiExternalSharedPoolGenerateOutputCodeFor: aVariableName with: aProgramGenerator - aProgramGenerator emitUnsignedIntegerOutputCodeFor: aVariableName! Item was removed: - ----- Method: Object>>asFFIExternalSharedPoolType (in category '*FFI-Pools') ----- - asFFIExternalSharedPoolType - FFIExternalSharedPoolException signal: - 'Cannot convert ', self class name asString, ' object to type'! Item was removed: - ----- Method: Object>>ffiExternalSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- - ffiExternalSharedPoolGenerateOutputCodeFor: aVariableName with: aProgramGenerator - FFIExternalSharedPoolException signal: - 'Cannot generate output code for ', self class name asString, ' object'! Item was removed: - ----- Method: String class>>ffiExternalSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- - ffiExternalSharedPoolGenerateOutputCodeFor: aVariableName with: aProgramGenerator - aProgramGenerator emitStringOutputCodeFor: aVariableName! Item was removed: - ----- Method: String>>asFFIExternalSharedPoolType (in category '*FFI-Pools') ----- - asFFIExternalSharedPoolType - | className | - - className := self asSymbol. - ^ self class environment - at: className - ifAbsent: [ - FFIExternalSharedPoolException signal: - 'Cannot use ', className asString, ' as type; ', - 'no matching class found']! Item was removed: - ----- Method: UndefinedObject>>asFFIExternalSharedPoolType (in category '*FFI-Pools') ----- - asFFIExternalSharedPoolType - "nil-typed variables are ommitted during program generation" - ^ self! Item was changed: + (PackageInfo named: 'FFI-Pools') postscript: 'Smalltalk removeFromStartUpList: ExternalPool.'! - (PackageInfo named: 'FFI-Pools') postscript: 'Smalltalk removeFromStartUpList: FFIExternalSharedPool.'!

2 1

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

02 Jun '20

Marcel Taeumel uploaded a new version of FFI-Pools to project FFI: http://source.squeak.org/FFI/FFI-Pools-mt.20.mcz ==================== Summary ==================== Name: FFI-Pools-mt.20 Author: mt Time: 2 June 2020, 8:26:38.439853 pm UUID: 1aa86859-8c1f-9640-aad7-d5799f9e226c Ancestors: FFI-Pools-mt.19 Due to the tricky load order of "FFI-Pools" before "FFI-Kernel" because of FFIConstants, lazily trigger the init code for that extra information about atomic types. =============== Diff against FFI-Pools-mt.19 =============== Item was removed: - ----- Method: ExternalPoolReadWriter class>>initialize (in category 'class initialization') ----- - initialize - - "self initializeAtomicTypesExtra."! Item was changed: ----- Method: ExternalPoolReadWriter>>cFormatPlaceholderFor: (in category 'writing - support') ----- cFormatPlaceholderFor: externalType "Limit access to printf format placeholders to instances of pool read-writers only." + AtomicCFormatPlaceholders ifNil: [self class initializeAtomicTypesExtra]. + ^ externalType isPointerType ifTrue: ['%p'] ifFalse: [ AtomicCFormatPlaceholders at: externalType atomicType ifAbsent: [nil]]! Item was changed: ----- Method: ExternalPoolReadWriter>>cTypeNameFor: (in category 'writing - support') ----- cTypeNameFor: externalType "Limit access to C type names to instances of pool read-writers only." | cTypeName | + AtomicCTypeNames ifNil: [self class initializeAtomicTypesExtra]. + cTypeName := AtomicCTypeNames at: externalType atomicType ifAbsent: [nil]. ^ externalType isPointerType ifTrue: [cTypeName, ' *'] ifFalse: [cTypeName]!

1 0

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

02 Jun '20

Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.88.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.88 Author: mt Time: 2 June 2020, 8:18:52.888853 pm UUID: 17387de1-88a7-1d42-b168-310574d0b78d Ancestors: FFI-Kernel-mt.87 Fixes a typo in the postscript. =============== Diff against FFI-Kernel-mt.87 =============== Item was changed: (PackageInfo named: 'FFI-Kernel') postscript: 'Smalltalk removeFromStartUpList: ExternalAddress. Smalltalk removeFromStartUpList: ExternalObject. + "Since #pointerSize in ExternalType is never nil anymore, make the code generated for fields more specific, i.e., #shortPointerAt:(put:) or #longPointerAt:(put:)." - "Since #pointerSize in ExternalType is never nil anymore, make the code generated for fields more specific, i.e., #shortPointerAt:(put:) or #longPointerAt:(put:). ExternalStructure withAllSubclassesDo: [:cls | cls defineFields]. '!

1 0

FFI: FFI-Win32-mt.17.mcz
by commits＠source.squeak.org 02 Jun '20

02 Jun '20

Marcel Taeumel uploaded a new version of FFI-Win32 to project FFI: http://source.squeak.org/FFI/FFI-Win32-mt.17.mcz ==================== Summary ==================== Name: FFI-Win32-mt.17 Author: mt Time: 2 June 2020, 8:13:09.982821 pm UUID: 2637aef5-7043-7f4e-bd85-b885abf44c3e Ancestors: FFI-Win32-cbc.16 Complements FFI-Pools-mt.18 =============== Diff against FFI-Win32-cbc.16 =============== Item was added: + ExternalPool subclass: #Win32Pool + instanceVariableNames: '' + classVariableNames: 'WIN32_WINNT_VISTA WIN32_WINNT_WIN10 WIN32_WINNT_WIN7 WIN32_WINNT_WIN8 WIN32_WINNT_WINXP' + poolDictionaries: '' + category: 'FFI-Win32-Examples'! Item was added: + ----- Method: Win32Pool class>>winver (in category 'definitions') ----- + winver + " + self winver writePoolData. + self winver readPoolData. + " + <ffiExternalPool> + <ffiPoolDataStorage: #methodSource> + <ffiPlatformName: 'Win32'> + + <ffiCHeaders: #('<sdkddkver.h>')> + <ffiVariable: #_WIN32_WINNT_WINXP> + <ffiVariable: #_WIN32_WINNT_VISTA> + <ffiVariable: #_WIN32_WINNT_WIN7> + <ffiVariable: #_WIN32_WINNT_WIN8> + <ffiVariable: #_WIN32_WINNT_WIN10> + + ^ self poolDefinition! Item was added: + ----- Method: Win32Pool class>>winverData (in category 'definitions - data') ----- + winverData + "Automatically generated." + <ffiPoolReadWriter: #ExternalPoolST1ReadWriter> + <ffiPoolDataStorage: #methodSource> + " + Win32Pool winver readPoolDataFrom: #methodSource. + Win32Pool winver writePoolDataTo: #methodSource. + " + ^ { + (FFIPlatformDescription name: 'Win32' osVersion: '10.0' subtype: 'IX86' wordSize: 4). + Dictionary new + at: #WIN32_WINNT_WIN7 put: 16r00000601; + at: #WIN32_WINNT_WINXP put: 16r00000501; + at: #WIN32_WINNT_VISTA put: 16r00000600; + at: #WIN32_WINNT_WIN8 put: 16r00000602; + at: #WIN32_WINNT_WIN10 put: 16r00000A00; + yourself. + } + !

1 0

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

02 Jun '20

Marcel Taeumel uploaded a new version of FFI-PoolsTests to project FFI: http://source.squeak.org/FFI/FFI-PoolsTests-mt.9.mcz ==================== Summary ==================== Name: FFI-PoolsTests-mt.9 Author: mt Time: 2 June 2020, 8:12:50.968821 pm UUID: e395981b-0a1c-3f44-b5ee-fe733d5e47cd Ancestors: FFI-PoolsTests-mt.8 Complements FFI-Pools-mt.18 =============== Diff against FFI-PoolsTests-mt.8 =============== Item was added: + ExternalPool subclass: #FFIExampleExternalPool + instanceVariableNames: '' + classVariableNames: 'EAGAIN EIO EWOULDBLOCK INT_MAX M_E M_PI ULONG_MAX' + poolDictionaries: '' + category: 'FFI-PoolsTests'! + + !FFIExampleExternalPool commentStamp: 'monty 4/17/2018 13:15' prior: 0! + A buildable example FFIExternalSharedPool that uses standard POSIX headers and symbols. + + self generateProgram. + self initializeFromGeneratedProgramOutput.! Item was added: + ----- Method: FFIExampleExternalPool class>>errors (in category 'definitions') ----- + errors + " + self errors writePoolData. + self errors readPoolData. + " + <ffiExternalPool> + <ffiPoolDataStorage: #methodSource> + + <ffiCHeaders: #('<errno.h>')> + + <ffiVariable: #EAGAIN type: 'long' convertTo: #Integer> + <ffiVariable: #EWOULDBLOCK type: 'long' convertTo: #Integer> + <ffiVariable: #EIO type: nil> + <ffiVariable: #M_PI type: nil> + <ffiVariable: #M_E type: nil> + <ffiVariable: #ULONG_MAX type: nil> + <ffiVariable: #INT_MAX type: nil> + + ^ self poolDefinition! Item was added: + ----- Method: FFIExampleExternalPool class>>errorsData (in category 'definitions - data') ----- + errorsData + "Automatically generated." + <ffiPoolReadWriter: #ExternalPoolST1ReadWriter> + <ffiPoolDataStorage: #methodSource> + " + FFIExampleExternalPool errors readPoolDataFrom: #methodSource. + FFIExampleExternalPool errors writePoolDataTo: #methodSource. + " + ^ { + (FFIPlatformDescription name: 'Win32' osVersion: '10.0' subtype: 'IX86' wordSize: 4). + Dictionary new + at: #EWOULDBLOCK put: 16r0000000B; + at: #EAGAIN put: 16r0000000B; + yourself. + } + ! Item was added: + ----- Method: FFIExampleExternalPool class>>limits (in category 'definitions') ----- + limits + " + self limits writePoolData. + self limits readPoolData. + " + <ffiExternalPool> + <ffiPoolDataStorage: #methodSource> + + <ffiInheritsFrom: #math> + + <ffiCHeaders: #('<math.h>' '<errno.h>' '<limits.h>')> + <ffiVariable: #ULONG_MAX type: 'ulong' convertTo: #LargePositiveInteger> + <ffiVariable: #INT_MAX type: 'long' convertTo: #Integer> + + ^ self poolDefinition! Item was added: + ----- Method: FFIExampleExternalPool class>>limitsData (in category 'definitions - data') ----- + limitsData + "Automatically generated." + <ffiPoolReadWriter: #ExternalPoolST1ReadWriter> + <ffiPoolDataStorage: #methodSource> + " + FFIExampleExternalPool limits readPoolDataFrom: #methodSource. + FFIExampleExternalPool limits writePoolDataTo: #methodSource. + " + ^ { + (FFIPlatformDescription name: 'Win32' osVersion: '10.0' subtype: 'IX86' wordSize: 4). + Dictionary new + at: #M_E put: (ExternalPoolST1ReadWriter readFloatFrom: '2.718281745910644531250e+00'); + at: #M_PI put: (ExternalPoolST1ReadWriter readFloatFrom: '3.141592741012573242188e+00'); + at: #EWOULDBLOCK put: 16r0000000B; + at: #EAGAIN put: 16r0000000B; + at: #INT_MAX put: 16r7FFFFFFF; + at: #ULONG_MAX put: 4294967295; + yourself. + } + ! Item was added: + ----- Method: FFIExampleExternalPool class>>math (in category 'definitions') ----- + math + " + self math writePoolData. + self math readPoolData. + " + <ffiExternalPool> + <ffiPoolDataStorage: #methodSource> + + <ffiInheritsFrom: #errors> + + <ffiCHeaders: #('<errno.h>' '<math.h>')> + <ffiVariable: #M_PI type: 'float' convertTo: #Float> + <ffiVariable: #M_E type: 'float' convertTo: #Float> + + ^ self poolDefinition! Item was added: + ----- Method: FFIExampleExternalPool class>>mathData (in category 'definitions - data') ----- + mathData + "Automatically generated." + <ffiPoolReadWriter: #ExternalPoolST1ReadWriter> + <ffiPoolDataStorage: #methodSource> + " + FFIExampleExternalPool math readPoolDataFrom: #methodSource. + FFIExampleExternalPool math writePoolDataTo: #methodSource. + " + ^ { + (FFIPlatformDescription name: 'Win32' osVersion: '10.0' subtype: 'IX86' wordSize: 4). + Dictionary new + at: #M_PI put: (ExternalPoolST1ReadWriter readFloatFrom: '3.141592741012573242188e+00'); + at: #EWOULDBLOCK put: 16r0000000B; + at: #EAGAIN put: 16r0000000B; + at: #M_E put: (ExternalPoolST1ReadWriter readFloatFrom: '2.718281745910644531250e+00'); + yourself. + } + ! Item was removed: - FFIExternalSharedPool subclass: #FFIExampleStandardExternalSharedPool - instanceVariableNames: '' - classVariableNames: 'EAGAIN EIO EWOULDBLOCK INT_MAX M_E M_PI ULONG_MAX' - poolDictionaries: '' - category: 'FFI-PoolsTests'! - - !FFIExampleStandardExternalSharedPool commentStamp: 'monty 4/17/2018 13:15' prior: 0! - A buildable example FFIExternalSharedPool that uses standard POSIX headers and symbols. - - self generateProgram. - self initializeFromGeneratedProgramOutput.! Item was removed: - ----- Method: FFIExampleStandardExternalSharedPool class>>errors (in category 'definitions') ----- - errors - <ffiExternalSharedPool> - <ffiCHeaders: #('<errno.h>')> - <ffiVariable: #EAGAIN type: #Integer> - <ffiVariable: #EWOULDBLOCK type: #Integer> - <ffiVariable: #EIO type: nil> - <ffiVariable: #M_PI type: nil> - <ffiVariable: #M_E type: nil> - <ffiVariable: #ULONG_MAX type: nil> - <ffiVariable: #INT_MAX type: nil>! Item was removed: - ----- Method: FFIExampleStandardExternalSharedPool class>>limits (in category 'definitions') ----- - limits - <ffiExternalSharedPool> - <ffiInheritsFrom: #math> - <ffiPlatformName: 'unix' wordSize: 4> - <ffiCFlags: '-Wall -o'> - <ffiCHeaders: #('<math.h>' '<errno.h>' '<limits.h>')> - <ffiVariable: #ULONG_MAX type: #LargePositiveInteger> - <ffiVariable: #INT_MAX type: #Integer>! Item was removed: - ----- Method: FFIExampleStandardExternalSharedPool class>>math (in category 'definitions') ----- - math - <ffiExternalSharedPool> - <ffiInheritsFrom: #errors> - <ffiPlatformName: 'unix'> - <ffiCHeaders: #('<errno.h>' '<math.h>')> - <ffiVariable: #M_PI type: #Float> - <ffiVariable: #M_E type: #Float>! Item was changed: ----- Method: FFIExternalSharedPoolProgramGeneratorTest>>newProgramGenerator (in category 'instance creation') ----- newProgramGenerator + ^ self programGeneratorClass on: String new writeStream + lineEnding: String lf + cHeaders: #()! - definition: FFITestExternalSharedPool defaultDefinition! Item was changed: ----- Method: FFIExternalSharedPoolProgramGeneratorTest>>programGeneratorClass (in category 'accessing') ----- programGeneratorClass + ^ ExternalPoolProgramGenerator! - ^ FFIExternalSharedPoolProgramGenerator! Item was changed: ----- Method: FFIExternalSharedPoolProgramGeneratorTest>>testEmitAllFormat (in category 'tests') ----- testEmitAllFormat | programGenerator | programGenerator := self newProgramGenerator. self assert: (programGenerator emitAll: '${1}two${2}$two$${1}' format: {'one'. 'three'}) == programGenerator. + self assert: programGenerator stream contents = 'onetwothree$two$one'. - self assert: programGenerator contents = 'onetwothree$two$one'. programGenerator := self newProgramGenerator. self assert: (programGenerator emitAll: '${one}two${three}$two$${one}' format: (Dictionary withAll: {'one' -> 1. 'three' -> 3})) == programGenerator. + self assert: programGenerator stream contents = '1two3$two$1'. - self assert: programGenerator contents = '1two3$two$1'. self should: [self newProgramGenerator emitAll: '${1}${2}' format: {1}] raise: Error. self should: [self newProgramGenerator emitAll: '${one}${two}' format: {'one' -> 1} asDictionary] raise: Error.! Item was changed: ----- Method: FFIExternalSharedPoolProgramGeneratorTest>>testLineEnding (in category 'tests') ----- testLineEnding {Character cr. Character lf. String crlf. 'NL'. $N} do: [:each | | programGenerator leString | programGenerator := self newProgramGenerator. + self assert: (programGenerator setLineEnding: each) == programGenerator. - self assert: (programGenerator lineEnding: each) == programGenerator. leString := each asString. self assert: programGenerator lineEnding equals: leString. programGenerator emitAll: 'one'; emitLineEnding; emitAll: 'two', String lf, 'three'; + emit: Character cr; "Rely on automatic conversion here." - emit: Character cr; emitAll: 'four'. self + assert: programGenerator stream contents - assert: programGenerator contents equals: 'one', leString, 'two', leString, 'three', leString, 'four']! Item was changed: ----- Method: FFIExternalSharedPoolTest>>assertIsDefaultDefinition:for: (in category 'asserting') ----- assertIsDefaultDefinition: aDefinition for: aSharedPool | classPool | self assert: aDefinition isDefault; assert: aDefinition name isNil; assert: aDefinition inheritsFrom isNil; assert: aDefinition cCompiler equals: self definitionClass defaultCCompiler; assert: aDefinition cFlags equals: self definitionClass defaultCFlags; assert: aDefinition cHeaders equals: self definitionClass defaultCHeaders; assert: aDefinition platform equals: self platformClass empty. self + assert: aDefinition poolReadWriterClass + equals: self definitionClass defaultPoolReadWriterClass. - assert: aDefinition programGeneratorClass - equals: self definitionClass defaultProgramGeneratorClass. classPool := aSharedPool classPool. classPool keysDo: [:each | self + assert: (aDefinition variablesAndTypesAt: each) value - assert: (aDefinition variablesAndTypesAt: each) equals: Integer]. self assert: classPool size equals: aDefinition variablesAndTypes size.! Item was added: + ----- Method: FFIExternalSharedPoolTest>>resolvedDefinitionsFor: (in category 'support') ----- + resolvedDefinitionsFor: sharedPool + + ^(sharedPool definitionResolverClass + on: sharedPool) resolvedDefinitions! Item was added: + ----- Method: FFIExternalSharedPoolTest>>resolvedToplevelDefinitionsFor: (in category 'support') ----- + resolvedToplevelDefinitionsFor: sharedPool + + ^ (sharedPool definitionResolverClass + class: sharedPool + definitions: (sharedPool definitions collect: [:each | each inheritsFrom: nil])) + resolvedDefinitions! Item was changed: ----- Method: FFIExternalSharedPoolTest>>testDefaultDefinition (in category 'tests') ----- testDefaultDefinition | sharedPool | sharedPool := FFITestDefaultDefinitionSharedPool. + self assert: (self resolvedDefinitionsFor: sharedPool) size equals: 1. - self assert: (sharedPool resolvedDefinitions) size equals: 1. self assertIsDefaultDefinition: (sharedPool preferredResolvedDefinitionForPlatform: self newTestPlatform) for: sharedPool.! Item was changed: ----- Method: FFIExternalSharedPoolTest>>testDefinitionLoops (in category 'tests') ----- testDefinitionLoops {FFITestLoopOneExternalSharedPool. FFITestLoopTwoExternalSharedPool. FFITestLoopThreeExternalSharedPool} do: [:sharedPool | self shouldnt: [sharedPool definitions] + raise: ExternalPoolError. - raise: FFIExternalSharedPoolException. self + should: [self resolvedDefinitionsFor: sharedPool] + raise: ExternalPoolError. - should: [sharedPool resolvedDefinitions] - raise: FFIExternalSharedPoolException. self + shouldnt: [self resolvedToplevelDefinitionsFor: sharedPool] + raise: ExternalPoolError].! - shouldnt: [ - sharedPool resolvedDefinitions: - (sharedPool definitions collect: [:each | - each inheritsFrom: nil])] - raise: FFIExternalSharedPoolException].! Item was changed: ----- Method: FFIExternalSharedPoolTest>>testDefinitionUnkownReferences (in category 'tests') ----- testDefinitionUnkownReferences | sharedPool | sharedPool := FFITestUnknownReferenceExternalSharedPool. self shouldnt: [sharedPool definitions] + raise: ExternalPoolError. - raise: FFIExternalSharedPoolException. self + should: [self resolvedDefinitionsFor: sharedPool] + raise: ExternalPoolError. - should: [sharedPool resolvedDefinitions] - raise: FFIExternalSharedPoolException. self + shouldnt: [self resolvedToplevelDefinitionsFor: sharedPool] + raise: ExternalPoolError.! - shouldnt: [ - sharedPool resolvedDefinitions: - (sharedPool definitions collect: [:each | - each inheritsFrom: nil])] - raise: FFIExternalSharedPoolException.! Item was changed: ----- Method: FFIExternalSharedPoolTest>>testInheritance (in category 'tests') ----- testInheritance | sharedPool definitions defaultDefinition emptyDefinition overrideDefinition | sharedPool := FFITestInheritanceExternalSharedPool. + definitions := self resolvedDefinitionsFor: sharedPool. - definitions := sharedPool resolvedDefinitions. 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 programGeneratorClass equals: defaultDefinition programGeneratorClass; 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 programGeneratorClass - equals: FFITestExternalSharedPoolProgramGenerator; assert: overrideDefinition variablesAndTypes + equals: (Dictionary withAll: {#One -> ((ExternalType atomicTypeNamed: 'float') -> Float). #Two -> ((ExternalType atomicTypeNamed: 'long') -> Integer)}).! - equals: (Dictionary withAll: {#One -> Float. #Two -> Integer}).! Item was changed: ----- Method: FFIExternalSharedPoolTest>>testPlatformAliasing (in category 'tests') ----- testPlatformAliasing | sharedPool definition | sharedPool := FFITestPlatformAliasingExternalSharedPool. self should: [ sharedPool preferredResolvedDefinitionForPlatform: self platformClass empty] + raise: ExternalPoolError. - raise: FFIExternalSharedPoolException. self should: [ sharedPool preferredResolvedDefinitionForPlatform: self newTestPlatform] + raise: ExternalPoolError. - raise: FFIExternalSharedPoolException. self shouldnt: [ definition := sharedPool preferredResolvedDefinitionForPlatform: (self newTestPlatform wordSize: 32)] + raise: ExternalPoolError. - raise: FFIExternalSharedPoolException. self assert: definition name equals: #five.! Item was added: + ----- Method: FFIExternalSharedPoolTest>>testPoolDefinition (in category 'tests') ----- + testPoolDefinition + + | sharedPool definition | + sharedPool := FFITestPoolDefinitionExternalSharedPool. + + definition := sharedPool base. + self assert: 'base' equals: definition platform name. + + definition := sharedPool override. + self + assert: #base equals: definition inheritsFrom; + assert: 'base' equals: definition platform name. "already resolved"! Item was changed: ----- Method: FFIExternalSharedPoolTest>>testVariableTypes (in category 'tests') ----- testVariableTypes | sharedPool resolvedDefinitions variables| sharedPool := FFITestTypesExternalSharedPool. + resolvedDefinitions := self resolvedDefinitionsFor: sharedPool. - resolvedDefinitions := sharedPool resolvedDefinitions. self assert: resolvedDefinitions size equals: 2. variables := #(Zero One Two Three Four Five Six). resolvedDefinitions do: [:definition | definition isDefault ifTrue: [ variables do: [:each | self + assert: (definition variablesAndTypesAt: each) value - assert: (definition variablesAndTypesAt: each) equals: Integer]] ifFalse: [ variables with: {Integer. Integer. Float. String. Character. Boolean. LargePositiveInteger} do: [:variable :type | self + assert: (definition variablesAndTypesAt: variable) value - assert: (definition variablesAndTypesAt: variable) equals: type]]].! Item was changed: + ExternalPool subclass: #FFITestExternalSharedPool - FFIExternalSharedPool subclass: #FFITestExternalSharedPool instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FFI-PoolsTests'! !FFITestExternalSharedPool commentStamp: 'monty 4/1/2018 10:30' prior: 0! These classes are used during testing and are not buildable.! Item was removed: - FFIExternalSharedPoolProgramGenerator subclass: #FFITestExternalSharedPoolProgramGenerator - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-PoolsTests'! - - !FFITestExternalSharedPoolProgramGenerator commentStamp: 'monty 4/1/2018 07:47' prior: 0! - A stub used during testing.! Item was changed: ----- Method: FFITestInheritanceExternalSharedPool class>>empty (in category 'definitions') ----- empty + <ffiExternalPool>! - <ffiExternalSharedPool>! Item was changed: ----- Method: FFITestInheritanceExternalSharedPool class>>override (in category 'definitions') ----- override + <ffiExternalPool> - <ffiExternalSharedPool> <ffiInheritsFrom: #empty> <ffiPlatformName: 'testName' osVersion: 'testOSVersion' subtype: 'testSubtype' wordSize: 16> <ffiCCompiler: 'testCompiler'> <ffiCFlags: 'testFlags'> <ffiCHeaders: #('<testHeader.h>' '"testLocalHeader.h"' 'testImplicitGlobalHeader.h')> + <ffiVariable: #One type: 'float' convertTo: #Float>! - <ffiProgramGenerator: #FFITestExternalSharedPoolProgramGenerator> - <ffiVariable: #One type: #Float>! Item was changed: ----- Method: FFITestLoopOneExternalSharedPool class>>one (in category 'definitions') ----- one + <ffiExternalPool> - <ffiExternalSharedPool> <ffiInheritsFrom: #one>! Item was changed: ----- Method: FFITestLoopThreeExternalSharedPool class>>one (in category 'definitions') ----- one + <ffiExternalPool> - <ffiExternalSharedPool> <ffiInheritsFrom: #three>! Item was changed: ----- Method: FFITestLoopThreeExternalSharedPool class>>three (in category 'definitions') ----- three + <ffiExternalPool> - <ffiExternalSharedPool> <ffiInheritsFrom: #two>! Item was changed: ----- Method: FFITestLoopThreeExternalSharedPool class>>two (in category 'definitions') ----- two + <ffiExternalPool> - <ffiExternalSharedPool> <ffiInheritsFrom: #one>! Item was changed: ----- Method: FFITestLoopTwoExternalSharedPool class>>one (in category 'definitions') ----- one + <ffiExternalPool> - <ffiExternalSharedPool> <ffiInheritsFrom: #two>! Item was changed: ----- Method: FFITestLoopTwoExternalSharedPool class>>two (in category 'definitions') ----- two + <ffiExternalPool> - <ffiExternalSharedPool> <ffiInheritsFrom: #one>! Item was changed: ----- Method: FFITestPlatformAliasingExternalSharedPool class>>five (in category 'definitions') ----- five + <ffiExternalPool> - <ffiExternalSharedPool> <ffiPlatformName: 'testName' osVersion: 'testOSVersion' subtype: 'testSubtype' wordSize: 32>! Item was changed: ----- Method: FFITestPlatformAliasingExternalSharedPool class>>four (in category 'definitions') ----- four + <ffiExternalPool> - <ffiExternalSharedPool> <ffiPlatformName: 'testName' osVersion: 'testOSVersion' subtype: 'testSubtype' wordSize: 16>! Item was changed: ----- Method: FFITestPlatformAliasingExternalSharedPool class>>one (in category 'definitions') ----- one + <ffiExternalPool>! - <ffiExternalSharedPool>! Item was changed: ----- Method: FFITestPlatformAliasingExternalSharedPool class>>three (in category 'definitions') ----- three + <ffiExternalPool> - <ffiExternalSharedPool> <ffiPlatformName: 'testName' osVersion: 'testOSVersion' subtype: 'testSubtype' wordSize: 16>! Item was changed: ----- Method: FFITestPlatformAliasingExternalSharedPool class>>two (in category 'definitions') ----- two + <ffiExternalPool>! - <ffiExternalSharedPool>! Item was changed: ----- Method: FFITestPlatformExternalSharedPool class>>definitionWithName (in category 'definitions') ----- definitionWithName + <ffiExternalPool> - <ffiExternalSharedPool> <ffiPlatformName: 'testName'>! Item was changed: ----- Method: FFITestPlatformExternalSharedPool class>>definitionWithNameOSVersion (in category 'definitions') ----- definitionWithNameOSVersion + <ffiExternalPool> - <ffiExternalSharedPool> <ffiPlatformName: 'testName' osVersion: 'testOSVersion'>! Item was changed: ----- Method: FFITestPlatformExternalSharedPool class>>definitionWithNameOSVersionSubtype (in category 'definitions') ----- definitionWithNameOSVersionSubtype + <ffiExternalPool> - <ffiExternalSharedPool> <ffiPlatformName: 'testName' osVersion: 'testOSVersion' subtype: 'testSubtype'>! Item was changed: ----- Method: FFITestPlatformExternalSharedPool class>>definitionWithNameOSVersionSubtypeWordSize (in category 'definitions') ----- definitionWithNameOSVersionSubtypeWordSize + <ffiExternalPool> - <ffiExternalSharedPool> <ffiPlatformName: 'testName' osVersion: 'testOSVersion' subtype: 'testSubtype' wordSize: 16>! Item was changed: ----- Method: FFITestPlatformExternalSharedPool class>>definitionWithNameWordSize (in category 'definitions') ----- definitionWithNameWordSize + <ffiExternalPool> - <ffiExternalSharedPool> <ffiPlatformName: 'testName' wordSize: 16>! Item was added: + FFITestExternalSharedPool subclass: #FFITestPoolDefinitionExternalSharedPool + instanceVariableNames: '' + classVariableNames: 'One Two' + poolDictionaries: '' + category: 'FFI-PoolsTests'! Item was added: + ----- Method: FFITestPoolDefinitionExternalSharedPool class>>base (in category 'as yet unclassified') ----- + base + <ffiExternalPool> + <ffiPlatformName: 'base'> + + ^ self poolDefinition! Item was added: + ----- Method: FFITestPoolDefinitionExternalSharedPool class>>override (in category 'as yet unclassified') ----- + override + <ffiExternalPool> + <ffiInheritsFrom: #base> + + ^ self poolDefinition! Item was changed: ----- Method: FFITestTypesExternalSharedPool class>>types (in category 'definitions') ----- types + <ffiExternalPool> + <ffiVariable: #One type: 'long' convertTo: #Integer> + <ffiVariable: #Two type: 'float' convertTo: #Float> + <ffiVariable: #Three type: 'char*' convertTo: #String> + <ffiVariable: #Four type: 'char' convertTo: #Character> + <ffiVariable: #Five type: 'long' convertTo: #Boolean> + <ffiVariable: #Six type: 'longlong' convertTo: #LargePositiveInteger>! - <ffiExternalSharedPool> - <ffiVariable: #One type: #Integer> - <ffiVariable: #Two type: #Float> - <ffiVariable: #Three type: #String> - <ffiVariable: #Four type: #Character> - <ffiVariable: #Five type: #Boolean> - <ffiVariable: #Six type: #LargePositiveInteger>! Item was changed: ----- Method: FFITestUnknownReferenceExternalSharedPool class>>one (in category 'definitions') ----- one + <ffiExternalPool> - <ffiExternalSharedPool> <ffiInheritsFrom: #unknown>!

1 0

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

02 Jun '20

Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.87.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.87 Author: mt Time: 2 June 2020, 8:12:39.748821 pm UUID: 79a5b863-4682-dc47-9570-328e0cf5457a Ancestors: FFI-Kernel-eem.86 Complements FFI-Pools-mt.18 =============== Diff against FFI-Kernel-eem.86 =============== Item was changed: Object subclass: #FFIPlatformDescription instanceVariableNames: 'name osVersion subtype wordSize' classVariableNames: 'LastPlatform' poolDictionaries: '' category: 'FFI-Kernel'! + !FFIPlatformDescription commentStamp: 'mt 6/2/2020 15:18' prior: 0! + This class stores the information about the current (host) platform. It supports testing instances for platform compatibility and specificity. The entire FFI machinery should go through here, when making platform-specific decisions such as when figuring out the #wordSize for pointers to external memory (i.e., ExternalAddress class >> #new) or when looking up compatible definitions for external pools (i.e., ExternalPool class >> #compatibleResolvedDefinitions). + + + 1. DETECT PLATFORM CHANGE ON STARTUP + + This class is registered for system startup. It then checks whether the current platform is different from the last one. In that case, a selection of FFI classes gets notified such as ExternalObject and ExternalType. + + + 2. PLATFORM SPECIFICITY + + Platform descriptions may be unspecific, that is, some of their values may be undefined. For example, (FFIPlatformDescription name: 'unix') creates a valid description but is not specific about #osVersion or #wordSize. When comparing such descriptions, precedence of the platform values are: + + platform name > osVersion > subtype > wordSize + + So, if one description has a #name and the other does not, the first one is more specific. If both have #name but only the second one has #osVersion, the second one is more specific. If one has only #wordSize and another one has only #subtype, the second one is more specific because #subtype has a higher precedence than #wordSize. + + + 3. PLATFORM COMPATIBILITY + + Platform descriptions implement a notion of compatibility, which is coupled to its notion of specificity as mentioned before. Using the same rules of precedence, compatibility is checked by comparing the description's values. If not specificed, compatibility is assumed. If specified, values must match via #= to be regarded compatible. + + Here is an interesting edge case of two compatible platform descriptions: + + | p1 p2 | + p1 := FFIPlatformDescription name: 'Win32' osVersion: '' subtype: 'IX86' wordSize: nil. + p2 := FFIPlatformDescription name: '' osVersion: 'linux-gnu' subtype: '' wordSize: 8. + p1 isCompatibleWith: p2. + + Consequently, the developer has to be careful with unspecific platform descriptions, which are used, for example, in the definitions of external pools. + + + 4. FURTHER READING + + - all references to FFIPlatformDescription + - all senders of #wordSize + - class comments of ExternalAddress, ExternalType, ExternalPool, ExternalObject + ! - !FFIPlatformDescription commentStamp: 'monty 4/1/2018 12:02' prior: 0! - This class stores the platform information for an FFIExternalSharedPool and supports testing instances for platform compatibility and specificity.! Item was added: + ----- Method: FFIPlatformDescription class>>cleanUp: (in category 'initialize-release') ----- + cleanUp: aggressive + + aggressive ifTrue: [ + "Force a detection of platform change on next system start up." + LastPlatform := nil].! Item was changed: ----- Method: FFIPlatformDescription class>>startUp: (in category 'system startup') ----- startUp: resuming "Notify all FFI classes about platform changes." resuming ifTrue: [ LastPlatform in: [:lastPlatform | self newCurrent in: [:currentPlatform | lastPlatform = currentPlatform ifTrue: [ self flag: #discuss. "mt: Maybe add #platformResuming?" ExternalAddress allBeNull] ifFalse: [ LastPlatform := currentPlatform. "Update now. See #current." + { ExternalType. ExternalAddress. ExternalObject. ExternalPool } - { ExternalType. ExternalAddress. ExternalObject. FFIExternalSharedPool } do: [:cls | cls platformChangedFrom: lastPlatform to: currentPlatform] ]]] ].!

1 0

FFI: FFI-Tests-mt.15.mcz
by commits＠source.squeak.org 02 Jun '20

02 Jun '20

Marcel Taeumel uploaded a new version of FFI-Tests to project FFI: http://source.squeak.org/FFI/FFI-Tests-mt.15.mcz ==================== Summary ==================== Name: FFI-Tests-mt.15 Author: mt Time: 2 June 2020, 8:06:43.727821 pm UUID: 818c1c5c-afd3-8e47-b692-0c0de5697f8e Ancestors: FFI-Tests-nice.14 Updates example structs with up-to-date code generation format, i.e., those <generated> pragmas and #shortPointer or #longPointer instead of just #pointer. =============== Diff against FFI-Tests-nice.14 =============== Item was changed: ----- Method: FFISmallStruct1>>x (in category 'accessing') ----- x + "This method was automatically generated. See FFISmallStruct1 class>>fields." + <generated> - "This method was automatically generated" ^handle unsignedByteAt: 1! Item was changed: ----- Method: FFISmallStruct1>>x: (in category 'accessing') ----- x: anObject + "This method was automatically generated. See FFISmallStruct1 class>>fields." + <generated> - "This method was automatically generated" handle unsignedByteAt: 1 put: anObject! Item was changed: ----- Method: FFISmallStruct1>>y (in category 'accessing') ----- y + "This method was automatically generated. See FFISmallStruct1 class>>fields." + <generated> - "This method was automatically generated" ^handle unsignedByteAt: 2! Item was changed: ----- Method: FFISmallStruct1>>y: (in category 'accessing') ----- y: anObject + "This method was automatically generated. See FFISmallStruct1 class>>fields." + <generated> - "This method was automatically generated" handle unsignedByteAt: 2 put: anObject! Item was changed: ----- Method: FFITestCompoundStruct>>p1 (in category 'accessing') ----- p1 "This method was automatically generated. See FFITestCompoundStruct class>>fields." <generated> + ^FFISmallStruct1 fromHandle: (handle shortPointerAt: 5)! - ^FFISmallStruct1 fromHandle: (handle pointerAt: 9)! Item was changed: ----- Method: FFITestCompoundStruct>>p1: (in category 'accessing') ----- p1: anObject "This method was automatically generated. See FFITestCompoundStruct class>>fields." <generated> + handle shortPointerAt: 5 put: anObject getHandle.! - handle pointerAt: 9 put: anObject getHandle.! Item was changed: ----- Method: FFITestCompoundStruct>>p2 (in category 'accessing') ----- p2 "This method was automatically generated. See FFITestCompoundStruct class>>fields." <generated> + ^FFITestPoint2 fromHandle: (handle shortPointerAt: 17)! - ^FFITestPoint2 fromHandle: (handle pointerAt: 25)! Item was changed: ----- Method: FFITestCompoundStruct>>p2: (in category 'accessing') ----- p2: anObject "This method was automatically generated. See FFITestCompoundStruct class>>fields." <generated> + handle shortPointerAt: 17 put: anObject getHandle.! - handle pointerAt: 25 put: anObject getHandle.! Item was changed: ----- Method: FFITestCompoundStruct>>p4 (in category 'accessing') ----- p4 "This method was automatically generated. See FFITestCompoundStruct class>>fields." <generated> + ^FFITestPoint4 fromHandle: (handle shortPointerAt: 37)! - ^FFITestPoint4 fromHandle: (handle pointerAt: 49)! Item was changed: ----- Method: FFITestCompoundStruct>>p4: (in category 'accessing') ----- p4: anObject "This method was automatically generated. See FFITestCompoundStruct class>>fields." <generated> + handle shortPointerAt: 37 put: anObject getHandle.! - handle pointerAt: 49 put: anObject getHandle.! Item was changed: ----- Method: FFITestCompoundStruct>>s2 (in category 'accessing') ----- s2 "This method was automatically generated. See FFITestCompoundStruct class>>fields." <generated> + ^FFITestPoint2 fromHandle: (handle structAt: 9 length: 8)! - ^FFITestPoint2 fromHandle: (handle structAt: 17 length: 8)! Item was changed: ----- Method: FFITestCompoundStruct>>s2: (in category 'accessing') ----- s2: anObject "This method was automatically generated. See FFITestCompoundStruct class>>fields." <generated> + handle structAt: 9 put: anObject getHandle length: 8.! - handle structAt: 17 put: anObject getHandle length: 8.! Item was changed: ----- Method: FFITestCompoundStruct>>s4 (in category 'accessing') ----- s4 "This method was automatically generated. See FFITestCompoundStruct class>>fields." <generated> + ^FFITestPoint4 fromHandle: (handle structAt: 21 length: 16)! - ^FFITestPoint4 fromHandle: (handle structAt: 33 length: 16)! Item was changed: ----- Method: FFITestCompoundStruct>>s4: (in category 'accessing') ----- s4: anObject "This method was automatically generated. See FFITestCompoundStruct class>>fields." <generated> + handle structAt: 21 put: anObject getHandle length: 16.! - handle structAt: 33 put: anObject getHandle length: 16.!

1 0

Jump to page: