Vm-dev June 2020

vm-dev@lists.squeakfoundation.org

23 participants
106 discussions

VM Maker Inbox: VMMaker.oscog-nice.2761.mcz
by commits＠source.squeak.org 25 Jun '20

25 Jun '20

Eliot Miranda uploaded a new version of VMMaker to project VM Maker Inbox: http://source.squeak.org/VMMakerInbox/VMMaker.oscog-nice.2761.mcz ==================== Summary ==================== Name: VMMaker.oscog-nice.2761 Author: nice Time: 20 June 2020, 8:11:09.897426 pm UUID: e8105e2b-a95e-4698-9a5f-939360e251b8 Ancestors: VMMaker.oscog-eem.2760 1) Revise a bit the tranformation of assignment/returns for C code generation (see below) 2) Do not try to generate SHA256Plugin, it's obsolete and absent from latest cryptography packages. In Smalltalk, every statement is an expression that can be used in other expression, assigned to variables, etc... In C, not all statements are valid expressions, or IOW, not all statements have a value. In C parlance, rvalues are the ones which can be used at the right of an assignment, lvalues the ones which can be used on the left of an assignment. While working on FFI, I had invalid code generated looking like: err = switch(atomicType) ... This is because there is brittle code for transforming some expressions, which are not generic enough. For example, we have similar TSwitchStmtListNode and TCaseStmtNode for handling #dispatchOn:in:, but not exactly same handling of both. Before this change, an overview can be given by reviewing senders of: #isSwitch #isCaseStmt This commit is an attempt to enhance/generalize handling of such non-rvalues by distributing the handling of those constructs in TParseNode hierarchy. A slight change, is that assigning/returning result of a caseOf: without otherwise clause did create a default branch with an error message and a default value for the returned expression/assigned variable. See #emitCCodeOn:addToEndOfCases:level:generator: or #emitCCodeOn:prependToEndOfCases:level:generator: The new #transformInAssignmentTo: only create the error message, but does not provide the default value. This is because type analysis might have been not yet taken place at time of transformation. Is this really needed? I don't think so. Please review! We might want to further extend the mechanism. =============== Diff against VMMaker.oscog-eem.2760 =============== Item was changed: ----- Method: TAssignmentNode>>emitStatementListExpansion:on:level:generator: (in category 'C code generation') ----- emitStatementListExpansion: stmtList on: aStream level: level generator: aCodeGen stmtList statements last = variable ifTrue: [^expression emitCCodeOn: aStream level: level generator: aCodeGen]. + (stmtList copy transformInAssignmentTo: variable) - stmtList copy - assignLastExpressionTo: variable; emitCCodeOn: aStream level: level generator: aCodeGen! Item was changed: ----- Method: TAssignmentNode>>emitStatementListExpansionAsExpression:on:level:generator: (in category 'C code generation') ----- emitStatementListExpansionAsExpression: stmtList on: aStream level: level generator: aCodeGen stmtList statements last = variable ifTrue: [^expression emitCCodeAsExpressionOn: aStream level: level generator: aCodeGen]. + (stmtList copy transformInAssignmentTo: variable) - stmtList copy - assignLastExpressionTo: variable; emitCCodeAsExpressionOn: aStream level: level generator: aCodeGen! Item was changed: ----- Method: TAssignmentNode>>emitValueExpansionOn:level:generator: (in category 'C code generation') ----- emitValueExpansionOn: aStream level: level generator: aCodeGen | stmtList lastStmt copiedStatements | self assert: (expression isSend and: [expression isValueExpansion]). stmtList := expression receiver. lastStmt := stmtList statements last. (lastStmt = variable or: [lastStmt isReturn]) ifTrue: [^expression emitCCodeOn: aStream level: level generator: aCodeGen]. + copiedStatements := stmtList copy transformInAssignmentTo: variable. - copiedStatements := stmtList copy. - copiedStatements statements - at: stmtList statements size - put: (TAssignmentNode new - setVariable: variable - expression: lastStmt). expression copy receiver: copiedStatements; emitCCodeOn: aStream level: level generator: aCodeGen! Item was added: + ----- Method: TAssignmentNode>>transformInAssignmentTo: (in category 'transformations') ----- + transformInAssignmentTo: aTVariableNode + "Avoid transforming: + x := expression + into: + x := x := expression" + + aTVariableNode = variable ifTrue: [^self]. + ^super transformInAssignmentTo: aTVariableNode! Item was changed: TParseNode subclass: #TCaseStmtNode + instanceVariableNames: 'expression firsts lasts cases otherwiseOrNil' - instanceVariableNames: 'expression firsts lasts cases' classVariableNames: '' poolDictionaries: '' category: 'VMMaker-Translation to C'! !TCaseStmtNode commentStamp: '<historical>' prior: 0! I implement the main dispatch case statements for bytecode and primitive dispatch. See TMethod classPool associationAt: #CaseStatements! Item was changed: ----- Method: TCaseStmtNode>>emitCCodeOn:level:generator: (in category 'C code generation') ----- emitCCodeOn: aStream level: level generator: aCodeGen | printMod expansions duplicates | printMod := false. (expression isVariable and: [expression name = 'currentBytecode']) ifTrue: [printMod := true. aStream nextPutAll: 'bytecodeDispatchDebugHook();'; cr; crtab: level. aCodeGen outputAsmLabel: 'bytecodeDispatch' on: aStream. aStream crtab: level]. aStream nextPutAll: 'switch ('. expression emitCCodeOn: aStream level: level generator: aCodeGen. aStream nextPutAll: ') {'; cr. expansions := aCodeGen suppressAsmLabelsWhile: [cases collect: [:case| self filterCommentsFrom: (String streamContents: [:s| case emitCCodeOn: s level: 0 generator: aCodeGen])]]. duplicates := Set new. 1 to: cases size do: [:i| (duplicates includes: i) ifFalse: [(duplicates addAll: ((i to: cases size) select: [:j| (expansions at: i) = (expansions at: j)])) do: [:k| (firsts at: k) to: (lasts at: k) do: [:caseIndex| aStream tab: level; nextPutAll: 'case '; print: caseIndex; nextPut: $:. (caseIndex > 255 and: [printMod]) ifTrue: [aStream nextPutAll: ' /*'; print: (caseIndex bitAnd: 255); nextPutAll: '*/']. aStream cr]]. (cases at: i) emitCCodeOn: aStream level: level + 1 generator: aCodeGen. aStream tab: level + 1; nextPutAll: 'break;'; cr]]. + otherwiseOrNil + ifNotNil: + [aStream + crtab: level; + nextPutAll: 'default:'; + cr. + otherwiseOrNil emitCCodeOn: aStream level: level + 1 generator: aCodeGen]. aStream tab: level; nextPut: $}! Item was added: + ----- Method: TCaseStmtNode>>isAnRValueIn: (in category 'testing') ----- + isAnRValueIn: aCodeGen + "A switch is not an rvalue" + + ^false! Item was added: + ----- Method: TCaseStmtNode>>transformInAssignmentTo: (in category 'transformations') ----- + transformInAssignmentTo: aTVariableNode + "Destructively transform the receiver so that each case is transformed into an assignment." + cases := cases collect: [:node | node copy transformInAssignmentTo: aTVariableNode]. + otherwiseOrNil := otherwiseOrNil isNil + ifTrue: [TStmtListNode new setArguments: #() statements: + {TSendNode new setSelector: #error + receiver: (TConstantNode new setValue: 'Case not found') + arguments: #()}] + ifFalse: [otherwiseOrNil copy transformInAssignmentTo: aTVariableNode]. + ^self! Item was added: + ----- Method: TGoToNode>>isAnRValueIn: (in category 'testing') ----- + isAnRValueIn: aCodeGen + "A goto is not an rvalue" + + ^false! Item was removed: - ----- Method: TMethod>>isConditionalToBeTransformedForAssignment:in: (in category 'inlining') ----- - isConditionalToBeTransformedForAssignment: aSend in: aCodeGen - "Answer if a send is of the form - e1 - ifTrue: [e2 ifTrue: [self m1] ifFalse: [self m2]] - ifFalse: [self m3] - such that at least one of the sends mN may be inlined.." - - ^(#(ifTrue:ifFalse: ifFalse:ifTrue:) includes: aSend selector) - and: [aSend args anySatisfy: - [:arg| | stmt | - self assert: arg isStmtList. - arg statements size > 1 - or: [(stmt := arg statements first) isSwitch - or: [stmt isSend - and: [(aCodeGen mayInline: stmt selector) - or: [self isConditionalToBeTransformedForAssignment: stmt in: aCodeGen]]]]]]! Item was changed: ----- Method: TMethod>>transformConditionalAssignment:in: (in category 'inlining') ----- transformConditionalAssignment: node in: aCodeGen "If possible answer the transformation of code of the form var := e1 ifTrue: [e2 ifTrue: [self m1] ifFalse: [self m2]] ifFalse: [self m3] into e1 ifTrue: [e2 ifTrue: [var := self m1] ifFalse: [var := self m2]] ifFalse: [var := self m3] + to allow inlining of m1, m2, et al. Otherwise answer nil. + Also apply to various C constructs like switch" - to allow inlining of m1, m2, et al. Otherwise answer nil." - | expr | ^(node isAssignment + and: [node expression mustTransformWhenAssignedIn: aCodeGen]) ifTrue: + [node expression copy transformInAssignmentTo: node variable]! - and: [(expr := node expression) isSend - and: [(#(ifTrue:ifFalse: ifFalse:ifTrue:) includes: expr selector) - and: [self isConditionalToBeTransformedForAssignment: expr in: aCodeGen]]]) ifTrue: - [expr copy - arguments: - (expr args collect: - [:stmtList| stmtList copy assignLastExpressionTo: node variable]); - yourself]! Item was changed: ----- Method: TMethod>>transformReturnSubExpression:toAssignmentOf:andGoto:unless:into: (in category 'inlining') ----- transformReturnSubExpression: node toAssignmentOf: exitVar andGoto: exitLabel unless: eliminateReturnSelfs into: aBinaryBlock | expr replacement | expr := node isReturn ifTrue: [node expression] ifFalse: [node]. replacement := (expr isVariable "Eliminate ^self's" and: [expr name = 'self' and: [eliminateReturnSelfs]]) ifTrue: [nil] ifFalse: [exitVar ifNil: [expr] + ifNotNil: [expr transformInAssignmentTo: (TVariableNode new setName: exitVar)]]. - ifNotNil: [TAssignmentNode new - setVariable: (TVariableNode new setName: exitVar) - expression: expr]]. node == parseTree statements last ifTrue: [aBinaryBlock value: replacement value: false] ifFalse: [replacement := replacement ifNil: [TGoToNode new setLabel: exitLabel; yourself] ifNotNil: [TStmtListNode new setArguments: #() statements: {replacement. TGoToNode new setLabel: exitLabel; yourself}; yourself]. aBinaryBlock value: replacement value: true]! Item was changed: ----- Method: TMethod>>transformReturns (in category 'type inference') ----- transformReturns + "Once the return type has been found or inferred, returns may need to be modified. - "Once the return type has been found or inferred, returns may bneed to be modified. If the return type is #void, any occurrences of ^expr must be replaced with expr. ^self. If the type is #sqInt any any occurrences of ^self are replaced with ^0." (returnType == #void or: [returnType == #sqInt]) ifFalse: [^self]. parseTree nodesWithParentsDo: [:node :parent| node isReturn ifTrue: [(node expression isVariable and: [node expression name = 'self']) ifTrue: [returnType = #sqInt ifTrue: [node setExpression: (TConstantNode new setValue: 0)]] ifFalse: [returnType = #void ifTrue: [parent replaceChild: node with: (TStmtListNode new setArguments: #() statements: {node expression. TReturnNode new setExpression: (TVariableNode new setName: 'self') yourself})]]]]! Item was added: + ----- Method: TParseNode>>isAnRValueIn: (in category 'testing') ----- + isAnRValueIn: aCodeGen + "Answer false if this node is potentially not a rvalue. + a rvalue is an expression that can occur to the right of an assignement. + In C code, not all expression can be a rvalue. + For example if() {} else {} are not rvalues, unless they can be transformed into a ()?: construct. + Likewise, while and for loops, switch statements are not possible rvalues. + This method has to take inlining into account, because a simple message send would be transformed into a function call which is an rvalue. + But if the method is inlined rather than called, this may not be the case. + Default behavior is to answer true, only notorious non-rvalues have to refine this" + + ^true + ! Item was added: + ----- Method: TParseNode>>mustTransformWhenAssignedIn: (in category 'testing') ----- + mustTransformWhenAssignedIn: aCodeGen + "Answer whether this node must be transformed when assigned to a variable + var := expr. + Not all statements can be used at the right of assignment in C (rvalues)." + + ^(self isAnRValueIn: aCodeGen) not + ! Item was added: + ----- Method: TParseNode>>transformInAssignmentTo: (in category 'transformations') ----- + transformInAssignmentTo: aTVariableNode + "Default behavior is to transform an expression into an assignement + var := expression. + This message has to be redefined in subclasses which are not rvalues." + ^TAssignmentNode new + setVariable: aTVariableNode + expression: self! Item was added: + ----- Method: TReturnNode>>isAnRValueIn: (in category 'testing') ----- + isAnRValueIn: aCodeGen + "This is not an rvalue, we cannot write: + x = return y" + + ^false! Item was added: + ----- Method: TReturnNode>>transformInAssignmentTo: (in category 'transformations') ----- + transformInAssignmentTo: aTVariableNode + "a return shall not be assigned: + x := condition ifTrue: [^nil] ifFalse: [2] + shall be transformed into: + condition ifTrue: [^nil] ifFalse: [x := 2]" + + ^self! Item was added: + ----- Method: TSendNode>>isAnRValueIn: (in category 'testing') ----- + isAnRValueIn: aCodeGen + self isConditionalSend + ifTrue: ["If all expressions of a conditional are rvalue, then the + conditional can be transformed into a ()?: construct and is + thus an rvalue" + ^ (receiver isAnRValueIn: aCodeGen) + and: [self args + allSatisfy: [:arg | arg isAnRValueIn: aCodeGen]]]. + "inlined message sends are potentially not rvalues" + ^ (aCodeGen mayInline: self selector) not! Item was added: + ----- Method: TSendNode>>mustTransformWhenAssignedIn: (in category 'transformations') ----- + mustTransformWhenAssignedIn: aCodeGen + "Answer whether this node must be transformed. + Avoid infinite transformation loops caused by unchanged nodes." + + (aCodeGen mayInline: self selector) ifTrue: [^false]. + ^super mustTransformWhenAssignedIn: aCodeGen! Item was added: + ----- Method: TSendNode>>transformInAssignmentTo: (in category 'transformations') ----- + transformInAssignmentTo: aTVariableNode + "transform a conditional: + condition ifTrue: [stmt1. stmt2] ifFalse: [stmt3. stmt4]. + into: + condition ifTrue: [stmt1. var := stmt2] ifFalse: [stmt3. var := stmt4]. + If the last expression is itself not an rvalue, it will be transformed recursively" + + self isConditionalSend ifTrue: [^self copy + arguments: + (self args collect: + [:stmtList| stmtList copy transformInAssignmentTo: aTVariableNode]); + yourself]. + "don't attempt to assign aTVariableNode with the error condition (like default switch missing)" + selector = #error ifTrue: [^self]. + ^super transformInAssignmentTo: aTVariableNode! Item was removed: - ----- Method: TStmtListNode>>assignLastExpressionTo: (in category 'transformations') ----- - assignLastExpressionTo: variableNode - "Destructively transform the receiver so that its last expression is assigned to the argument." - | index | - index := statements findLast: [:expr| (expr isGoTo or: [expr isLabel]) not]. - statements - at: index - put: (TAssignmentNode new - setVariable: variableNode - expression: (statements at: index))! Item was added: + ----- Method: TStmtListNode>>isAnRValueIn: (in category 'testing') ----- + isAnRValueIn: aCodeGen + "A list of statements is not an rvalue... + Well, in simple cases we could use comma operator (,), but don't bother here." + + ^statements size = 1 and: [statements first isAnRValueIn: aCodeGen]! Item was added: + ----- Method: TStmtListNode>>transformInAssignmentTo: (in category 'transformations') ----- + transformInAssignmentTo: aTVariableNode + "Destructively transform the receiver so that its last expression is assigned to the argument." + | index | + index := statements findLast: [:expr| (expr isGoTo or: [expr isLabel]) not]. + statements + at: index + put: ((statements at: index) copy transformInAssignmentTo: aTVariableNode). + ^self! Item was added: + ----- Method: TSwitchStmtNode>>isAnRValueIn: (in category 'testing') ----- + isAnRValueIn: aCodeGen + "A switch is not an rvalue" + + ^false! Item was added: + ----- Method: TSwitchStmtNode>>transformInAssignmentTo: (in category 'transformations') ----- + transformInAssignmentTo: aTVariableNode + "Destructively transform the receiver so that each case is transformed into an assignment." + cases := cases collect: [:pair | {pair first. pair last copy transformInAssignmentTo: aTVariableNode}]. + otherwiseOrNil := otherwiseOrNil isNil + ifTrue: [TStmtListNode new setArguments: #() statements: + {TSendNode new setSelector: #error + receiver: (TConstantNode new setValue: 'Case not found and no otherwise clause') + arguments: #()}] + ifFalse: [otherwiseOrNil copy transformInAssignmentTo: aTVariableNode]. + ^self! Item was added: + ----- Method: TVariableNode>>transformInAssignmentTo: (in category 'transformations') ----- + transformInAssignmentTo: aTVariableNode + "Avoid transforming: + x + into: + x := x" + + aTVariableNode = self ifTrue: [^self]. + ^super transformInAssignmentTo: aTVariableNode! Item was changed: ----- Method: VMMaker class>>generateVMPlugins (in category 'configurations') ----- generateVMPlugins ^VMMaker generatePluginsTo: self sourceTree, '/src' options: #() platformDir: self sourceTree, '/platforms' including:#(ADPCMCodecPlugin AsynchFilePlugin BalloonEnginePlugin B3DAcceleratorPlugin B3DEnginePlugin BMPReadWriterPlugin BitBltSimulation BochsIA32Plugin BochsX64Plugin GdbARMv6Plugin GdbARMv8Plugin CameraPlugin CroquetPlugin DeflatePlugin DropPlugin + "Cryptography Plugins:" DESPlugin DSAPlugin MD5Plugin - "Cryptography Plugins:" DESPlugin DSAPlugin MD5Plugin SHA256Plugin "FT2Plugin" FFTPlugin FileCopyPlugin FilePlugin FileAttributesPlugin Float64ArrayPlugin FloatArrayPlugin FloatMathPlugin GeniePlugin HostWindowPlugin IA32ABIPlugin ImmX11Plugin InternetConfigPlugin JPEGReadWriter2Plugin JPEGReaderPlugin JoystickTabletPlugin KlattSynthesizerPlugin LargeIntegersPlugin LocalePlugin MIDIPlugin MacMenubarPlugin Matrix2x3Plugin MiscPrimitivePlugin Mpeg3Plugin QuicktimePlugin RePlugin ScratchPlugin SecurityPlugin SerialPlugin SocketPlugin SoundCodecPlugin SoundGenerationPlugin SoundPlugin SqueakSSLPlugin StarSqueakPlugin ThreadedFFIPlugin ThreadedARM32FFIPlugin ThreadedARM64FFIPlugin ThreadedIA32FFIPlugin ThreadedX64SysVFFIPlugin ThreadedX64Win64FFIPlugin UnicodePlugin UnixAioPlugin UUIDPlugin UnixOSProcessPlugin Win32OSProcessPlugin VMProfileLinuxSupportPlugin VMProfileMacSupportPlugin WeDoPlugin XDisplayControlPlugin)!

1 0

[OpenSmalltalk/opensmalltalk-vm] 72cf32: CogV source as per VMMaker.oscog-eem.2761
by Eliot Miranda 24 Jun '20

24 Jun '20

Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: 72cf325e0ccd3bc6da3c73d12fc1fcfe08a4110d https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/72cf325e0ccd3bc6da… Author: Eliot Miranda <eliot.miranda(a)gmail.com> Date: 2020-06-24 (Wed, 24 Jun 2020) Changed paths: M nsspur64src/vm/cogit.h M nsspur64src/vm/cogitX64SysV.c M nsspur64src/vm/cogitX64WIN64.c M nsspur64src/vm/cointerp.c M nsspur64src/vm/cointerp.h M nsspur64src/vm/gcc3x-cointerp.c M nsspursrc/vm/cogit.h M nsspursrc/vm/cogitARMv5.c M nsspursrc/vm/cogitIA32.c M nsspursrc/vm/cogitMIPSEL.c M nsspursrc/vm/cointerp.c M nsspursrc/vm/cointerp.h M nsspursrc/vm/gcc3x-cointerp.c M nsspurstack64src/vm/gcc3x-interp.c M nsspurstack64src/vm/interp.c M nsspurstacksrc/vm/gcc3x-interp.c M nsspurstacksrc/vm/interp.c M platforms/iOS/plugins/CameraPlugin/AVFoundationVideoGrabber.m M scripts/revertIfEssentiallyUnchanged M spur64src/vm/cogit.h M spur64src/vm/cogitX64SysV.c M spur64src/vm/cogitX64WIN64.c M spur64src/vm/cointerp.c M spur64src/vm/cointerp.h M spur64src/vm/cointerpmt.c M spur64src/vm/cointerpmt.h M spur64src/vm/gcc3x-cointerp.c M spur64src/vm/gcc3x-cointerpmt.c M spurlowcode64src/vm/cogit.h M spurlowcode64src/vm/cogitX64SysV.c M spurlowcode64src/vm/cogitX64WIN64.c M spurlowcode64src/vm/cointerp.c M spurlowcode64src/vm/cointerp.h M spurlowcode64src/vm/gcc3x-cointerp.c M spurlowcodesrc/vm/cogit.h M spurlowcodesrc/vm/cogitARMv5.c M spurlowcodesrc/vm/cogitIA32.c M spurlowcodesrc/vm/cogitMIPSEL.c M spurlowcodesrc/vm/cointerp.c M spurlowcodesrc/vm/cointerp.h M spurlowcodesrc/vm/gcc3x-cointerp.c M spurlowcodestack64src/vm/gcc3x-interp.c M spurlowcodestack64src/vm/interp.c M spurlowcodestacksrc/vm/gcc3x-interp.c M spurlowcodestacksrc/vm/interp.c M spursista64src/vm/cogit.h M spursista64src/vm/cogitX64SysV.c M spursista64src/vm/cogitX64WIN64.c M spursista64src/vm/cointerp.c M spursista64src/vm/cointerp.h M spursista64src/vm/gcc3x-cointerp.c M spursistasrc/vm/cogit.h M spursistasrc/vm/cogitARMv5.c M spursistasrc/vm/cogitIA32.c M spursistasrc/vm/cogitMIPSEL.c M spursistasrc/vm/cointerp.c M spursistasrc/vm/cointerp.h M spursistasrc/vm/gcc3x-cointerp.c M spursrc/vm/cogit.h M spursrc/vm/cogitARMv5.c M spursrc/vm/cogitIA32.c M spursrc/vm/cogitMIPSEL.c M spursrc/vm/cointerp.c M spursrc/vm/cointerp.h M spursrc/vm/cointerpmt.c M spursrc/vm/cointerpmt.h M spursrc/vm/gcc3x-cointerp.c M spursrc/vm/gcc3x-cointerpmt.c M spurstack64src/vm/gcc3x-interp.c M spurstack64src/vm/interp.c M spurstack64src/vm/validImage.c M spurstacksrc/vm/gcc3x-interp.c M spurstacksrc/vm/interp.c M spurstacksrc/vm/validImage.c M src/plugins/MiscPrimitivePlugin/MiscPrimitivePlugin.c M src/vm/cogit.h M src/vm/cogitARMv5.c M src/vm/cogitIA32.c M src/vm/cogitMIPSEL.c M src/vm/cointerp.c M src/vm/cointerp.h M src/vm/cointerpmt.c M src/vm/cointerpmt.h M src/vm/gcc3x-cointerp.c M src/vm/gcc3x-cointerpmt.c M stacksrc/vm/gcc3x-interp.c M stacksrc/vm/interp.c Log Message: ----------- CogV source as per VMMaker.oscog-eem.2761 Author: eem Time: 24 June 2020, 11:15:52.846414 am UUID: 34b29eae-6069-4cb7-8a89-7365fb398dfb Ancestors: VMMaker.oscog-eem.2760 Cherry Picking from various recent commits, but avoiding the extremely desirable, but as yet unfinished, VMMaker.oscog-nice.2761 transformInAssignmentTo: changes.the "thisContext method includes: 42" crash. MiscPrimitivePlugin: fix several uses of sizeOfSTArrayFromCPrimitive: that don''t check for potential failure if e.g. invoked on a CompiledMethod. Returning from a primitive normally when the primtiive has failed leads to disaster since the stack gets cu back but shouldn't be. For CompiledMethod isBytes: is true but isWordsOrBytes: is false. sizeOfSTArrayFromCPrimitive: checks for isWordsOrBytes:. The primtiives check that the argument is isBytes: but don't check if sizeOfSTArrayFromCPrimitive: fails. More general fixes, such as fixing isBytes: to be false for CompiledMethod, or introducing isPureBytes: and using it, are not quick fixes. hence this limited fix here. Primitive infrastructure: consequently guard the various methodReturnXXX''s with an assert to check that a primitive has not failed. Also make sure that the SpurNBitCoMemoryManagers do not follow any reference to a Cog method in the first field of a CompiledMethod. Cosmetic changes for ThreadedFFIPlugins from VMMaker.oscog-nice.2762 Do not try to generate SHA256Plugin, it's obsolete and absent from latest cryptography packages. This from VMMaker.oscog-nice.2761. Slang: Fix TParseNode>>isSameAs: implementations to incluyde an identity check. TReturnNode always answered false to this in the past. Optimize inlineFunctionCall:in: to avoid a rewrite of the copied parse tree being inlined if the actuals match the formals. Uses the improved bindVariablesIn:. Use a setter for variable & expression in TAssignmentNode to ease breakpointing/debugging. Scripts: Fix revertIfEssentiallyUnchanged to handle the threaded FFI plugins now they include version info in the moduleName routine. Commit: 93b9f887c47d0e27104741ff4203f48a648a8f6e https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/93b9f887c47d0e2710… Author: Eliot Miranda <eliot.miranda(a)gmail.com> Date: 2020-06-24 (Wed, 24 Jun 2020) Changed paths: M .travis.yml M third-party/libssh2.spec Log Message: ----------- Merge branch 'Cog' of https://github.com/OpenSmalltalk/opensmalltalk-vm into Cog Compare: https://github.com/OpenSmalltalk/opensmalltalk-vm/compare/32457868b901...93…

1 0

VM Maker Inbox: VMMaker.oscog-eem.2766.mcz
by commits＠source.squeak.org 24 Jun '20

24 Jun '20

Eliot Miranda uploaded a new version of VMMaker to project VM Maker Inbox: http://source.squeak.org/VMMakerInbox/VMMaker.oscog-eem.2766.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2766 Author: eem Time: 23 June 2020, 7:19:31.803115 pm UUID: 308db3f3-ab74-442d-a8ac-d142375477b1 Ancestors: VMMaker.oscog-eem.2765 Spur: For Slang to inline numPointerSlotsOf:format: into followForwardedObjectFields:toDepth: (given Slang's current limitations) we must simply assign the result of numPointerSlotsOf:format: to a variable, not use it in an expression. =============== Diff against VMMaker.oscog-eem.2765 =============== Item was changed: + ----- Method: Spur32BitCoMemoryManager>>followForwardedObjectFields:toDepth: (in category 'forwarding') ----- - ----- Method: Spur32BitCoMemoryManager>>followForwardedObjectFields:toDepth: (in category 'as yet unclassified') ----- followForwardedObjectFields: objOop toDepth: depth "Follow pointers in the object to depth. Answer if any forwarders were found. How to avoid cyclic structures?? A temporary mark bit? eem 6/22/2020 no need since depth is always finite." <api> <inline: false> + | found fmt numSlots | - | found fmt limit | found := false. self assert: ((self isPointers: objOop) or: [self isOopCompiledMethod: objOop]). fmt := self formatOf: objOop. + numSlots := self numPointerSlotsOf: objOop format: fmt. - limit := (self numPointerSlotsOf: objOop format: fmt) - 1. "It is essential to skip the first field of a method because it may be a reference to a Cog method in the method zone, not a real object at all." ((self isCompiledMethodFormat: fmt) ifTrue: [1] ifFalse: [0]) + to: numSlots - 1 - to: limit do: [:i| | oop | oop := self fetchPointer: i ofObject: objOop. (self isNonImmediate: oop) ifTrue: [(self isForwarded: oop) ifTrue: [found := true. oop := self followForwarded: oop. self storePointer: i ofObject: objOop withValue: oop]. (depth > 0 and: [(self hasPointerFields: oop) and: [self followForwardedObjectFields: oop toDepth: depth - 1]]) ifTrue: [found := true]]]. ^found! Item was changed: ----- Method: Spur64BitCoMemoryManager>>followForwardedObjectFields:toDepth: (in category 'forwarding') ----- followForwardedObjectFields: objOop toDepth: depth "Follow pointers in the object to depth. Answer if any forwarders were found. How to avoid cyclic structures?? A temporary mark bit? eem 6/22/2020 no need since depth is always finite." <api> <inline: false> + | found fmt numSlots | - | found fmt limit | found := false. self assert: ((self isPointers: objOop) or: [self isOopCompiledMethod: objOop]). fmt := self formatOf: objOop. + numSlots := self numPointerSlotsOf: objOop format: fmt. - limit := (self numPointerSlotsOf: objOop format: fmt) - 1. "It is essential to skip the first field of a method because it may be a reference to a Cog method in the method zone, not a real object at all." ((self isCompiledMethodFormat: fmt) ifTrue: [1] ifFalse: [0]) + to: numSlots - 1 - to: limit do: [:i| | oop | oop := self fetchPointer: i ofObject: objOop. (self isNonImmediate: oop) ifTrue: [(self isForwarded: oop) ifTrue: [found := true. oop := self followForwarded: oop. self storePointer: i ofObject: objOop withValue: oop]. (depth > 0 and: [(self hasPointerFields: oop) and: [self followForwardedObjectFields: oop toDepth: depth - 1]]) ifTrue: [found := true]]]. ^found!

1 0

VM Maker Inbox: VMMaker.oscog-eem.2764.mcz
by commits＠source.squeak.org 23 Jun '20

23 Jun '20

Eliot Miranda uploaded a new version of VMMaker to project VM Maker Inbox: http://source.squeak.org/VMMakerInbox/VMMaker.oscog-eem.2764.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2764 Author: eem Time: 23 June 2020, 12:43:04.297105 pm UUID: 1e841de6-39e5-4db6-9634-97e0b3f80bbe Ancestors: VMMaker.oscog-eem.2763 Interim refactored VMMaker.oscog-nice.2762. Code generation is still broken, but on its way to being repaired. Badic refactoring is to add a codeGen parameter to transformInAssignmentTo: so that isAnRValueIn: can be used there-in. There is still a bug that assignments are getting added after the error in a case with no otherwise. That's bogus. error never returns. Fixed isSameAs: to do an equality check. Fixed the fixed point in ensureConditionalAssignmentsAreTransformedIn: so that iteration stops if no change is made to the parse tree on transforming assignments. =============== Diff against VMMaker.oscog-eem.2763 =============== Item was changed: ----- Method: CogARMCompiler>>concretizeAndCqRR (in category 'generate machine code - concretize') ----- concretizeAndCqRR "Will get inlined into concretizeAt: switch." "AND is very important since it's used to mask all sorts of flags in the jit. We take special care to try to find compact ways to make the masks" <inline: true> | val srcReg dstReg | val := operands at: 0. srcReg := operands at: 1. dstReg := operands at: 2. self rotateable8bitBitwiseImmediate: val ifTrue: [:rot :immediate :invert| self machineCodeAt: 0 put: (invert ifTrue: [self bics: dstReg rn: srcReg imm: immediate ror: rot] ifFalse: [self ands: dstReg rn: srcReg imm: immediate ror: rot]). ^4] ifFalse: [| hb | hb := (operands at: 0) highBit. "First see if the constant can be made from a simple shift of 0xFFFFFFFF" 1 << hb = (val +1) ifTrue: "MVN temp reg, 0, making 0xffffffff" [self machineCodeAt: 0 put:(self mvn: ConcreteIPReg imm: 0 ror: 0). "Then AND reg, temp reg, lsr #(32-hb)" self machineCodeAt: 4 put: (self dataOpType: AndOpcode rd: dstReg rn: srcReg rm: ConcreteIPReg lsr: 32 - hb). + ^8]]. + ^self concretizeDataOperationCwR: AndOpcode R: dstReg! - ^8]. - ^self concretizeDataOperationCwR: AndOpcode R: dstReg]! Item was changed: ----- Method: TAssignmentNode>>bindVariablesIn: (in category 'transformations') ----- bindVariablesIn: aDictionary + self setVar: (variable bindVariablesIn: aDictionary) + exp: (expression bindVariablesIn: aDictionary)! - variable := variable bindVariablesIn: aDictionary. - expression := expression bindVariablesIn: aDictionary.! Item was changed: ----- Method: TAssignmentNode>>emitStatementListExpansion:on:level:generator: (in category 'C code generation') ----- emitStatementListExpansion: stmtList on: aStream level: level generator: aCodeGen + self deny: (aCodeGen hasVariable: variable name). stmtList statements last = variable ifTrue: [^expression emitCCodeOn: aStream level: level generator: aCodeGen]. + (stmtList copy transformInAssignmentTo: variable codeGen: aCodeGen) - (stmtList copy transformInAssignmentTo: variable) emitCCodeOn: aStream level: level generator: aCodeGen! Item was changed: ----- Method: TAssignmentNode>>emitStatementListExpansionAsExpression:on:level:generator: (in category 'C code generation') ----- emitStatementListExpansionAsExpression: stmtList on: aStream level: level generator: aCodeGen + self deny: (aCodeGen hasVariable: variable name). stmtList statements last = variable ifTrue: [^expression emitCCodeAsExpressionOn: aStream level: level generator: aCodeGen]. + (stmtList copy transformInAssignmentTo: variable codeGen: aCodeGen) - (stmtList copy transformInAssignmentTo: variable) emitCCodeAsExpressionOn: aStream level: level generator: aCodeGen! Item was changed: ----- Method: TAssignmentNode>>emitValueExpansionOn:level:generator: (in category 'C code generation') ----- emitValueExpansionOn: aStream level: level generator: aCodeGen | stmtList lastStmt copiedStatements | self assert: (expression isSend and: [expression isValueExpansion]). stmtList := expression receiver. lastStmt := stmtList statements last. + self deny: (aCodeGen hasVariable: variable name). (lastStmt = variable or: [lastStmt isReturn]) ifTrue: [^expression emitCCodeOn: aStream level: level generator: aCodeGen]. + copiedStatements := stmtList copy transformInAssignmentTo: variable codeGen: aCodeGen. - copiedStatements := stmtList copy transformInAssignmentTo: variable. expression copy receiver: copiedStatements; emitCCodeOn: aStream level: level generator: aCodeGen! Item was changed: ----- Method: TAssignmentNode>>isSameAs: (in category 'testing') ----- isSameAs: aTParseNode + ^self == aTParseNode + or: [aTParseNode isAssignment + and: [(variable isSameAs: aTParseNode variable) + and: [expression isSameAs: aTParseNode expression]]]! - ^aTParseNode isAssignment - and: [(variable isSameAs: aTParseNode variable) - and: [expression isSameAs: aTParseNode expression]]! Item was changed: ----- Method: TAssignmentNode>>postCopy (in category 'copying') ----- postCopy + self setVar: variable copy exp: expression copy! - variable := variable copy. - expression := expression copy! Item was changed: ----- Method: TAssignmentNode>>replaceNodesIn: (in category 'transformations') ----- replaceNodesIn: aDictionary + ^aDictionary + at: self + ifAbsent: + [self setVar: (variable replaceNodesIn: aDictionary) + exp: (expression replaceNodesIn: aDictionary)]! - ^aDictionary at: self ifAbsent: [ - variable := variable replaceNodesIn: aDictionary. - expression := expression replaceNodesIn: aDictionary. - self]! Item was added: + ----- Method: TAssignmentNode>>setVar:exp: (in category 'private') ----- + setVar: varNode exp: expressionNode + "This is a private setter, just for breakpointing..." + variable := varNode. + expression := expressionNode! Item was changed: ----- Method: TAssignmentNode>>setVariable:expression: (in category 'accessing') ----- setVariable: varNode expression: expressionNode self assert: (expressionNode isGoTo or: [expressionNode isLabel]) not. + variable := varNode. + expression := expressionNode! - expression := expressionNode.! Item was removed: - ----- Method: TAssignmentNode>>transformInAssignmentTo: (in category 'transformations') ----- - transformInAssignmentTo: aTVariableNode - "Avoid transforming: - x := expression - into: - x := x := expression" - - aTVariableNode = variable ifTrue: [^self]. - ^super transformInAssignmentTo: aTVariableNode! Item was added: + ----- Method: TAssignmentNode>>transformInAssignmentTo:codeGen: (in category 'transformations') ----- + transformInAssignmentTo: aTVariableNode codeGen: aCodeGen + "Avoid transforming: + x := expression + into: + x := x := expression" + + aTVariableNode = variable ifTrue: [^self]. + ^super transformInAssignmentTo: aTVariableNode codeGen: aCodeGen! Item was changed: ----- Method: TCaseStmtNode>>processSharedCodeBlocks:forCase:in:method:expandedCases: (in category 'transformations') ----- + processSharedCodeBlocks: caseTree forCase: caseIndex in: aCodeGen method: aTMethod expandedCases: seen - processSharedCodeBlocks: caseTree forCase: caseIndex in: codeGen method: aTMethod expandedCases: seen "Process any shared code blocks in the case parse tree for the given case, either inlining them or making them a 'goto sharedLabel'." | caseMethod map meth sharedNode exitLabel | exitLabel := nil. "caseTree is expected to be a TStmtListNode whose first element is a comment and whose second element is a TInlineNode for a method." caseMethod := caseTree statements second method. [sharedNode := nil. map := IdentityDictionary new. caseTree nodesDo: [:node| (sharedNode isNil and: [node isSend + and:[(meth := aCodeGen methodNamed: node selector) notNil - and:[(meth := codeGen methodNamed: node selector) notNil and:[meth sharedCase notNil]]]) ifTrue: [(meth sharedCase = (meth sharedCase isSymbol ifTrue: [caseMethod selector] ifFalse: [caseIndex]) and: [(seen includes: meth sharedLabel) not]) ifTrue: ["If the bytecode (the caseMethod) ends with a message that has a lastCase (and lastLabel) then that will be converted into a goto and control will continue to that code, If the bytecode does /not/ end with a message that has a lastCase (and lastLabel) then control should not continue to that shared case. expandViaFallThrough captures this, true for the former, false for the latter." | expandViaFallThrough | expandViaFallThrough := false. caseMethod statements last isSend ifTrue: + [(aCodeGen methodNamed: caseMethod statements last selector) ifNotNil: - [(codeGen methodNamed: caseMethod statements last selector) ifNotNil: [:m| expandViaFallThrough := m sharedCase notNil]]. seen add: meth sharedLabel. map at: node put: (expandViaFallThrough ifTrue: [sharedNode := meth. TLabeledCommentNode new setComment: 'goto ', meth sharedLabel] ifFalse: ["Still need recursive expansjon to continue but don't want to duplicate the node, so substitue an empty method." sharedNode := TLabeledCommentNode new setComment: 'null '. meth copy renameLabelsForInliningInto: aTMethod; addLabelsTo: aTMethod; asInlineNode])] ifFalse: [map at: node put: (TGoToNode new setLabel: meth sharedLabel)]]]. caseTree replaceNodesIn: map. "recursively expand" sharedNode notNil] whileTrue: [sharedNode isTMethod ifTrue: [meth := sharedNode copy. meth hasReturn ifTrue: [exitLabel ifNil: [exitLabel := aTMethod unusedLabelForInliningInto: aTMethod. aTMethod labels add: exitLabel]. + meth exitVar: nil label: exitLabel in: aCodeGen]. - meth exitVar: nil label: exitLabel]. meth renameLabelsForInliningInto: aTMethod; addLabelsTo: aTMethod. caseTree setStatements: (caseTree statements copyWith: meth asInlineNode)]]. exitLabel ifNotNil: [caseTree setStatements: (caseTree statements copyWith: (TLabeledCommentNode new setLabel: exitLabel comment: 'end case'))]! Item was removed: - ----- Method: TCaseStmtNode>>transformInAssignmentTo: (in category 'transformations') ----- - transformInAssignmentTo: aTVariableNode - "Destructively transform the receiver so that each case is transformed into an assignment." - cases := cases collect: [:node | node copy transformInAssignmentTo: aTVariableNode]. - otherwiseOrNil := otherwiseOrNil isNil - ifTrue: [TStmtListNode new setArguments: #() statements: - {TSendNode new setSelector: #error - receiver: (TConstantNode new setValue: 'Case not found') - arguments: #()}] - ifFalse: [otherwiseOrNil copy transformInAssignmentTo: aTVariableNode]. - ^self! Item was added: + ----- Method: TCaseStmtNode>>transformInAssignmentTo:codeGen: (in category 'transformations') ----- + transformInAssignmentTo: aTVariableNode codeGen: aCodeGen + "Destructively transform the receiver so that each case is transformed into an assignment." + + cases := cases collect: [:node | node copy transformInAssignmentTo: aTVariableNode codeGen: aCodeGen]. + otherwiseOrNil := otherwiseOrNil + ifNil: + [TStmtListNode new + setArguments: #() + statements: + {(TSendNode new + setSelector: #error + receiver: (TConstantNode new setValue: 'Case not found') arguments: #())}] + ifNotNil: + [otherwiseOrNil copy transformInAssignmentTo: aTVariableNode codeGen: aCodeGen]! Item was changed: ----- Method: TConstantNode>>isSameAs: (in category 'comparing') ----- isSameAs: aTParseNode + ^self == aTParseNode + or: [aTParseNode isConstant + and: [value class == aTParseNode value class + and: [value = aTParseNode value]]]! - ^aTParseNode isConstant - and: [value class == aTParseNode value class - and: [value = aTParseNode value]]! Item was changed: ----- Method: TDefineNode>>isSameAs: (in category 'comparing') ----- isSameAs: aTParseNode + ^self == aTParseNode + or: [self class == aTParseNode class + and: [value class == aTParseNode value class + and: [value = aTParseNode value + and: [name = aTParseNode nameOrValue]]]]! - ^self class == aTParseNode class - and: [value class == aTParseNode value class - and: [value = aTParseNode value - and: [name = aTParseNode nameOrValue]]]! Item was added: + ----- Method: TLabeledCommentNode>>transformInAssignmentTo:codeGen: (in category 'transformations') ----- + transformInAssignmentTo: aTVariableNode codeGen: anObject + "These nodes should *not* be transformed." + ^self! Item was changed: ----- Method: TMethod>>deny: (in category 'error handling') ----- deny: aBooleanOrBlock - <doNotGenerate> aBooleanOrBlock value ifTrue: [AssertionFailure signal: 'Assertion failed']! Item was changed: ----- Method: TMethod>>ensureConditionalAssignmentsAreTransformedIn: (in category 'inlining') ----- ensureConditionalAssignmentsAreTransformedIn: aCodeGen "Make passes transforming foo := expr ifTrue: [a] ifFalse: [b] into expr ifTrue: [foo := a] ifFalse: [foo := b] until no such instances exist in the tree. This is needed for correct inlining given the limitations of inlineCodeOrNilForStatement:returningNodes:in:" + | transformedAssignments newTree | - | transformedAssignments | [transformedAssignments := Dictionary new. parseTree nodesDo: [:node| (self transformConditionalAssignment: node in: aCodeGen) ifNotNil: [:replacement| transformedAssignments at: node put: replacement]] unless: "Don't inline the arguments to asserts to keep the asserts readable" [:node| node isSend and: [node selector == #cCode:inSmalltalk: or: [aCodeGen isAssertSelector: node selector]]]. + transformedAssignments isEmpty + or: [(newTree := parseTree replaceNodesIn: transformedAssignments) isSameAs: parseTree]] whileFalse: + [self deny: newTree printString = parseTree printString. + parseTree := newTree] - transformedAssignments notEmpty - and: [self replaceNodesIn: transformedAssignments. - true]] whileTrue ! Item was removed: - ----- Method: TMethod>>exitVar:label: (in category 'inlining') ----- - exitVar: exitVar label: exitLabel - "Replace each return statement in this method with an assignment to the - exit variable followed by either a return or a goto to the given label. - Answer if a goto was generated." - "Optimization: If exitVar is nil, the return value of the inlined method is not being used, so don't add the assignment statement." - - | labelUsed map elisions eliminateReturnSelfs | - labelUsed := false. - map := Dictionary new. - elisions := Set new. - "Conceivably one might ^self from a struct class and mean it. In most cases though - ^self means `get me outta here, fast'. So unless this method is from a VMStruct class, - elide any ^self's" - eliminateReturnSelfs := ((definingClass inheritsFrom: VMClass) and: [definingClass isStructClass]) not - and: [returnType = #void or: [returnType = #sqInt]]. - parseTree nodesDo: - [:node | | replacement | - node isReturn ifTrue: - [self transformReturnSubExpression: node - toAssignmentOf: exitVar - andGoto: exitLabel - unless: eliminateReturnSelfs - into: [:rep :labelWasUsed| - replacement := rep. - labelWasUsed ifTrue: [labelUsed := true]]. - "replaceNodesIn: is strictly top-down, so any replacement for ^expr ifTrue: [...^fu...] ifFalse: [...^bar...] - will prevent replacement of either ^fu or ^bar. The corollary is that ^expr ifTrue: [foo] ifFalse: [^bar] - must be transformed into expr ifTrue: [^foo] ifFalse: [^bar]" - (node expression isConditionalSend - and: [node expression hasExplicitReturn]) - ifTrue: - [elisions add: node. - (node expression args reject: [:arg| arg endsWithReturn]) do: - [:nodeNeedingReturn| - self transformReturnSubExpression: nodeNeedingReturn statements last - toAssignmentOf: exitVar - andGoto: exitLabel - unless: eliminateReturnSelfs - into: [:rep :labelWasUsed| - replacement := rep. - labelWasUsed ifTrue: [labelUsed := true]]. - map - at: nodeNeedingReturn statements last - put: replacement]] - ifFalse: - [map - at: node - put: (replacement ifNil: - [TLabeledCommentNode new setComment: 'return ', node expression printString])]]]. - map isEmpty ifTrue: - [self deny: labelUsed. - ^false]. - "Now do a top-down replacement for all returns that should be mapped to assignments and gotos" - parseTree replaceNodesIn: map. - "Now it is safe to eliminate the returning ifs..." - elisions isEmpty ifFalse: - [| elisionMap | - elisionMap := Dictionary new. - elisions do: [:returnNode| elisionMap at: returnNode put: returnNode expression]. - parseTree replaceNodesIn: elisionMap]. - "Now flatten any new statement lists..." - parseTree nodesDo: - [:node| | list | - (node isStmtList - and: [node statements notEmpty - and: [node statements last isStmtList]]) ifTrue: - [list := node statements last statements. - node statements removeLast; addAllLast: list]]. - ^labelUsed! Item was added: + ----- Method: TMethod>>exitVar:label:in: (in category 'inlining') ----- + exitVar: exitVar label: exitLabel in: aCodeGen + "Replace each return statement in this method with an assignment to the + exit variable followed by either a return or a goto to the given label. + Answer if a goto was generated." + "Optimization: If exitVar is nil, the return value of the inlined method is not being used, so don't add the assignment statement." + + | labelUsed map elisions eliminateReturnSelfs | + labelUsed := false. + map := Dictionary new. + elisions := Set new. + "Conceivably one might ^self from a struct class and mean it. In most cases though + ^self means `get me outta here, fast'. So unless this method is from a VMStruct class, + elide any ^self's" + eliminateReturnSelfs := ((definingClass inheritsFrom: VMClass) and: [definingClass isStructClass]) not + and: [returnType = #void or: [returnType = #sqInt]]. + parseTree nodesDo: + [:node | | replacement | + node isReturn ifTrue: + [self transformReturnSubExpression: node + toAssignmentOf: exitVar + andGoto: exitLabel + unless: eliminateReturnSelfs + into: [:rep :labelWasUsed| + replacement := rep. + labelWasUsed ifTrue: [labelUsed := true]] + in: aCodeGen. + "replaceNodesIn: is strictly top-down, so any replacement for ^expr ifTrue: [...^fu...] ifFalse: [...^bar...] + will prevent replacement of either ^fu or ^bar. The corollary is that ^expr ifTrue: [foo] ifFalse: [^bar] + must be transformed into expr ifTrue: [^foo] ifFalse: [^bar]" + (node expression isConditionalSend + and: [node expression hasExplicitReturn]) + ifTrue: + [elisions add: node. + (node expression args reject: [:arg| arg endsWithReturn]) do: + [:nodeNeedingReturn| + self transformReturnSubExpression: nodeNeedingReturn statements last + toAssignmentOf: exitVar + andGoto: exitLabel + unless: eliminateReturnSelfs + into: [:rep :labelWasUsed| + replacement := rep. + labelWasUsed ifTrue: [labelUsed := true]]. + map + at: nodeNeedingReturn statements last + put: replacement]] + ifFalse: + [map + at: node + put: (replacement ifNil: + [TLabeledCommentNode new setComment: 'return ', node expression printString])]]]. + map isEmpty ifTrue: + [self deny: labelUsed. + ^false]. + "Now do a top-down replacement for all returns that should be mapped to assignments and gotos" + parseTree replaceNodesIn: map. + "Now it is safe to eliminate the returning ifs..." + elisions isEmpty ifFalse: + [| elisionMap | + elisionMap := Dictionary new. + elisions do: [:returnNode| elisionMap at: returnNode put: returnNode expression]. + parseTree replaceNodesIn: elisionMap]. + "Now flatten any new statement lists..." + parseTree nodesDo: + [:node| | list | + (node isStmtList + and: [node statements notEmpty + and: [node statements last isStmtList]]) ifTrue: + [list := node statements last statements. + node statements removeLast; addAllLast: list]]. + ^labelUsed! Item was changed: ----- Method: TMethod>>inlineCaseStatementBranchesIn:localizingVars: (in category 'inlining') ----- inlineCaseStatementBranchesIn: aCodeGen localizingVars: varsList | maxTemp usedVars v exitLabel | maxTemp := 0. parseTree nodesDo: [:n | n isCaseStmt ifTrue: [n cases do: [:stmtNode | | newStatements stmt meth | (stmt := stmtNode statements first) isSend ifTrue: [(meth := (aCodeGen methodNamed: stmt selector)) isNil ifFalse: [(meth hasUnrenamableCCode or: [meth args notEmpty]) ifFalse: [meth := meth copy. meth hasReturn ifTrue: [exitLabel := meth unusedLabelForInliningInto: self. + meth exitVar: nil label: exitLabel in: aCodeGen. - meth exitVar: nil label: exitLabel. labels add: exitLabel] ifFalse: [exitLabel := nil]. meth renameLabelsForInliningInto: self. labels addAll: meth labels. newStatements := stmtNode statements asOrderedCollection allButFirst. exitLabel ifNotNil: [newStatements addFirst: (TLabeledCommentNode new setLabel: exitLabel comment: 'end case')]. newStatements addFirst: meth asInlineNode; addFirst: (TLabeledCommentNode new setComment: meth selector). stmtNode setStatements: newStatements]]]]]]. usedVars := (locals , args) asSet. 1 to: maxTemp do: [:i | v := 't' , i printString. (usedVars includes: v) ifTrue: [self error: 'temp variable name conflicts with an existing local or arg']. locals addLast: v]. "make local versions of the given globals" locals addAll: (varsList reject: [:var | usedVars includes: var])! Item was changed: ----- Method: TMethod>>inlineSend:directReturn:exitVar:in: (in category 'inlining') ----- inlineSend: aSendNode directReturn: directReturn exitVar: exitVar in: aCodeGen "Answer a collection of statements to replace the given send. directReturn indicates that the send is the expression in a return statement, so returns can be left in the body of the inlined method. If exitVar is nil, the value returned by the send is not used; thus, returns need not assign to the output variable. Types are propagated to as-yet-untyped variables when inlining a send that is assigned, otherwise the assignee variable type must match the return type of the inlinee. Return types are not propagated." | sel meth methArgs exitLabel inlineStmts label exitType elidedArgs | sel := aSendNode selector. meth := aCodeGen methodNamed: sel. methArgs := meth args. "convenient for debugging..." aCodeGen maybeBreakForInlineOf: aSendNode in: self. elidedArgs := #(). (methArgs notEmpty and: [methArgs first beginsWith: 'self_in_']) ifTrue: "If the first arg is not used we can and should elide it." [| varNode | varNode := TVariableNode new setName: methArgs first. (meth parseTree noneSatisfy: [:node| varNode isSameAs: node]) ifTrue: [elidedArgs := {methArgs first}]. methArgs := methArgs allButFirst]. methArgs size = aSendNode args size ifFalse: [^nil]. meth := meth copy. (meth statements size > 1 and: [meth statements first isSend and: [meth statements first selector == #flag:]]) ifTrue: [meth statements removeFirst]. "Propagate the return type of an inlined method" (directReturn or: [exitVar notNil]) ifTrue: [exitType := directReturn ifTrue: [returnType] ifFalse: [(self typeFor: exitVar in: aCodeGen) ifNil: [#sqInt]]. (exitType = #void or: [exitType = meth returnType]) ifFalse: [meth propagateReturnIn: aCodeGen]]. "Propagate any unusual argument types to untyped argument variables" methArgs with: aSendNode args do: [:formal :actual| (meth declarationAt: formal ifAbsent: nil) ifNil: [(self typeFor: actual in: aCodeGen) ifNotNil: [:type| type ~= #sqInt ifTrue: [meth declarationAt: formal put: (type last = $* ifTrue: [type, formal] ifFalse: [type, ' ', formal])]]]]. meth renameVarsForInliningInto: self except: elidedArgs in: aCodeGen. meth renameLabelsForInliningInto: self. self addVarsDeclarationsAndLabelsOf: meth except: elidedArgs. meth hasReturn ifTrue: [directReturn ifFalse: [exitLabel := self unusedLabelForInliningInto: self. + (meth exitVar: exitVar label: exitLabel in: aCodeGen) "is label used?" - (meth exitVar: exitVar label: exitLabel) "is label used?" ifTrue: [ labels add: exitLabel ] ifFalse: [ exitLabel := nil ]]]. (inlineStmts := OrderedCollection new: meth statements size + meth args size + 2) add: (label := TLabeledCommentNode new setComment: 'begin ', sel); addAll: (self argAssignmentsFor: meth send: aSendNode except: elidedArgs in: aCodeGen); addAll: meth statements. "method body" directReturn ifTrue: [meth endsWithReturn ifTrue: [exitVar ifNotNil: "don't remove the returns if being invoked in the context of a return" [inlineStmts at: inlineStmts size put: inlineStmts last copyWithoutReturn]] ifFalse: [inlineStmts add: (TReturnNode new setExpression: (TVariableNode new setName: 'nil'))]]. exitLabel ifNotNil: [inlineStmts add: (TLabeledCommentNode new setLabel: exitLabel comment: 'end ', meth selector)]. inlineStmts size = 1 ifTrue: "Nuke empty methods; e.g. override of flushAtCache" [self assert: inlineStmts first isComment. inlineStmts removeFirst]. ^inlineStmts! Item was changed: ----- Method: TMethod>>transformConditionalAssignment:in: (in category 'inlining') ----- transformConditionalAssignment: node in: aCodeGen "If possible answer the transformation of code of the form var := e1 ifTrue: [e2 ifTrue: [self m1] ifFalse: [self m2]] ifFalse: [self m3] into e1 ifTrue: [e2 ifTrue: [var := self m1] ifFalse: [var := self m2]] ifFalse: [var := self m3] to allow inlining of m1, m2, et al. Otherwise answer nil. Also apply to various C constructs like switch" ^(node isAssignment and: [node expression mustTransformWhenAssignedIn: aCodeGen]) ifTrue: + [node expression copy transformInAssignmentTo: node variable codeGen: aCodeGen]! - [node expression copy transformInAssignmentTo: node variable]! Item was removed: - ----- Method: TMethod>>transformReturnSubExpression:toAssignmentOf:andGoto:unless:into: (in category 'inlining') ----- - transformReturnSubExpression: node toAssignmentOf: exitVar andGoto: exitLabel unless: eliminateReturnSelfs into: aBinaryBlock - | expr replacement | - expr := node isReturn ifTrue: [node expression] ifFalse: [node]. - replacement := (expr isVariable "Eliminate ^self's" - and: [expr name = 'self' - and: [eliminateReturnSelfs]]) - ifTrue: [nil] - ifFalse: - [exitVar - ifNil: [expr] - ifNotNil: [expr transformInAssignmentTo: (TVariableNode new setName: exitVar)]]. - node == parseTree statements last - ifTrue: - [aBinaryBlock value: replacement value: false] - ifFalse: - [replacement := replacement - ifNil: [TGoToNode new setLabel: exitLabel; yourself] - ifNotNil: - [TStmtListNode new - setArguments: #() - statements: {replacement. - TGoToNode new setLabel: exitLabel; yourself}; - yourself]. - aBinaryBlock value: replacement value: true]! Item was added: + ----- Method: TMethod>>transformReturnSubExpression:toAssignmentOf:andGoto:unless:into:in: (in category 'inlining') ----- + transformReturnSubExpression: node toAssignmentOf: exitVar andGoto: exitLabel unless: eliminateReturnSelfs into: aBinaryBlock in: aCodeGen + | expr replacement | + expr := node isReturn ifTrue: [node expression] ifFalse: [node]. + replacement := (expr isVariable "Eliminate ^self's" + and: [expr name = 'self' + and: [eliminateReturnSelfs]]) + ifTrue: [nil] + ifFalse: + [exitVar + ifNil: [expr] + ifNotNil: [expr transformInAssignmentTo: (TVariableNode new setName: exitVar) codeGen: aCodeGen]]. + node == parseTree statements last + ifTrue: + [aBinaryBlock value: replacement value: false] + ifFalse: + [replacement := replacement + ifNil: [TGoToNode new setLabel: exitLabel; yourself] + ifNotNil: + [TStmtListNode new + setArguments: #() + statements: {replacement. + TGoToNode new setLabel: exitLabel; yourself}; + yourself]. + aBinaryBlock value: replacement value: true]! Item was added: + ----- Method: TParseNode>>deny: (in category 'as yet unclassified') ----- + deny: aBooleanOrBlock + aBooleanOrBlock value ifTrue: [AssertionFailure signal: 'Assertion failed']! Item was changed: ----- Method: TParseNode>>isSameAs: (in category 'comparing') ----- isSameAs: aTParseNode "Answer if the ParseTree rooted at this node is the same as aTParseNode. By default answer false and have subclasses override as appropriate." + ^self == aTParseNode! - ^false! Item was removed: - ----- Method: TParseNode>>transformInAssignmentTo: (in category 'transformations') ----- - transformInAssignmentTo: aTVariableNode - "Default behavior is to transform an expression into an assignement - var := expression. - This message has to be redefined in subclasses which are not rvalues." - ^TAssignmentNode new - setVariable: aTVariableNode - expression: self! Item was added: + ----- Method: TParseNode>>transformInAssignmentTo:codeGen: (in category 'transformations') ----- + transformInAssignmentTo: aTVariableNode codeGen: anObject + "Default behavior is to transform an expression into an assignement + var := expression. + This message has to be redefined in subclasses which are not rvalues." + ^TAssignmentNode new + setVariable: aTVariableNode + expression: self! Item was added: + ----- Method: TReturnNode>>isSameAs: (in category 'comparing') ----- + isSameAs: aTParseNode + ^self == aTParseNode + or: [aTParseNode isReturn + and: [expression isSameAs: aTParseNode expression]]! Item was removed: - ----- Method: TReturnNode>>transformInAssignmentTo: (in category 'transformations') ----- - transformInAssignmentTo: aTVariableNode - "a return shall not be assigned: - x := condition ifTrue: [^nil] ifFalse: [2] - shall be transformed into: - condition ifTrue: [^nil] ifFalse: [x := 2]" - - ^self! Item was added: + ----- Method: TReturnNode>>transformInAssignmentTo:codeGen: (in category 'transformations') ----- + transformInAssignmentTo: aTVariableNode codeGen: anObject + "a return shall not be assigned: + x := condition ifTrue: [^nil] ifFalse: [2] + shall be transformed into: + condition ifTrue: [^nil] ifFalse: [x := 2]" + + ^self! Item was changed: ----- Method: TSendNode>>isSameAs: (in category 'comparing') ----- isSameAs: aTParseNode + self == aTParseNode ifTrue: [^true]. (aTParseNode isSend and: [selector == aTParseNode selector and: [receiver isSameAs: aTParseNode receiver]]) ifFalse: [^false]. arguments with: aTParseNode args do: [:a :b| (a isSameAs: b) ifFalse: [^false]]. ^true! Item was removed: - ----- Method: TSendNode>>transformInAssignmentTo: (in category 'transformations') ----- - transformInAssignmentTo: aTVariableNode - "transform a conditional: - condition ifTrue: [stmt1. stmt2] ifFalse: [stmt3. stmt4]. - into: - condition ifTrue: [stmt1. var := stmt2] ifFalse: [stmt3. var := stmt4]. - If the last expression is itself not an rvalue, it will be transformed recursively" - - self isConditionalSend ifTrue: [^self copy - arguments: - (self args collect: - [:stmtList| stmtList copy transformInAssignmentTo: aTVariableNode]); - yourself]. - "don't attempt to assign aTVariableNode with the error condition (like default switch missing)" - selector = #error ifTrue: [^self]. - ^super transformInAssignmentTo: aTVariableNode! Item was added: + ----- Method: TSendNode>>transformInAssignmentTo:codeGen: (in category 'transformations') ----- + transformInAssignmentTo: aTVariableNode codeGen: aCodeGen + "transform a conditional: + condition ifTrue: [stmt1. stmt2] ifFalse: [stmt3. stmt4]. + into: + condition ifTrue: [stmt1. var := stmt2] ifFalse: [stmt3. var := stmt4]. + Iff any of the arms is returning, since the assignment may be eliminated in that case, + or any of the arms must be transformed because it is not an r-value." + + selector = #error ifTrue: [^self]. + (self isConditionalSend + and: [arguments anySatisfy: [:arg | (arg isAnRValueIn: aCodeGen) not or: [arg endsWithReturn]]]) ifTrue: + [^self copy + arguments: (arguments collect: [ :stmtList | stmtList copy transformInAssignmentTo: aTVariableNode codeGen: aCodeGen]); + yourself]. "don't attempt to assign aTVariableNode with the error condition (like default switch missing)" + ^super transformInAssignmentTo: aTVariableNode codeGen: aCodeGen! Item was changed: ----- Method: TStmtListNode>>isSameAs: (in category 'testing') ----- isSameAs: aTParseNode + self == aTParseNode ifTrue: [^true]. (aTParseNode isStmtList and: [statements size = aTParseNode statements size]) ifFalse: [^false]. statements with: aTParseNode statements do: [:mine :theirs| (mine isSameAs: theirs) ifFalse: [^false]]. ^true! Item was removed: - ----- Method: TStmtListNode>>transformInAssignmentTo: (in category 'transformations') ----- - transformInAssignmentTo: aTVariableNode - "Destructively transform the receiver so that its last expression is assigned to the argument." - | index | - index := statements findLast: [:expr| (expr isGoTo or: [expr isLabel]) not]. - statements - at: index - put: ((statements at: index) copy transformInAssignmentTo: aTVariableNode). - ^self! Item was added: + ----- Method: TStmtListNode>>transformInAssignmentTo:codeGen: (in category 'transformations') ----- + transformInAssignmentTo: aTVariableNode codeGen: aCodeGen + "Destructively transform the receiver so that its last expression is assigned to the argument." + | index | + index := statements findLast: [:expr| (expr isGoTo or: [expr isLabel]) not]. + statements + at: index + put: ((statements at: index) copy transformInAssignmentTo: aTVariableNode codeGen: aCodeGen)! Item was removed: - ----- Method: TSwitchStmtNode>>transformInAssignmentTo: (in category 'transformations') ----- - transformInAssignmentTo: aTVariableNode - "Destructively transform the receiver so that each case is transformed into an assignment." - cases := cases collect: [:pair | {pair first. pair last copy transformInAssignmentTo: aTVariableNode}]. - otherwiseOrNil := otherwiseOrNil isNil - ifTrue: [TStmtListNode new setArguments: #() statements: - {TSendNode new setSelector: #error - receiver: (TConstantNode new setValue: 'Case not found and no otherwise clause') - arguments: #()}] - ifFalse: [otherwiseOrNil copy transformInAssignmentTo: aTVariableNode]. - ^self! Item was added: + ----- Method: TSwitchStmtNode>>transformInAssignmentTo:codeGen: (in category 'transformations') ----- + transformInAssignmentTo: aTVariableNode codeGen: aCodeGen + "Destructively transform the receiver so that each case is transformed into an assignment." + + cases := cases collect: [:pair | {pair first. pair last copy transformInAssignmentTo: aTVariableNode codeGen: aCodeGen}]. + otherwiseOrNil := otherwiseOrNil + ifNil: [TStmtListNode new setArguments: #() statements: + {TSendNode new setSelector: #error + receiver: (TConstantNode new setValue: 'Case not found and no otherwise clause') + arguments: #()}] + ifNotNil: [otherwiseOrNil copy transformInAssignmentTo: aTVariableNode codeGen: aCodeGen]! Item was changed: ----- Method: TVariableNode>>isSameAs: (in category 'comparing') ----- isSameAs: aTParseNode + ^self == aTParseNode + or: [aTParseNode isVariable + and: [name = aTParseNode name]]! - ^aTParseNode isVariable - and: [name = aTParseNode name]! Item was removed: - ----- Method: TVariableNode>>transformInAssignmentTo: (in category 'transformations') ----- - transformInAssignmentTo: aTVariableNode - "Avoid transforming: - x - into: - x := x" - - aTVariableNode = self ifTrue: [^self]. - ^super transformInAssignmentTo: aTVariableNode! Item was added: + ----- Method: TVariableNode>>transformInAssignmentTo:codeGen: (in category 'transformations') ----- + transformInAssignmentTo: aTVariableNode codeGen: aCodeGen + "Avoid transforming: + x + into: + x := x" + + aTVariableNode = self ifTrue: [^self]. + ^super transformInAssignmentTo: aTVariableNode codeGen: aCodeGen!

1 0

VM Maker: VMMaker.oscog-nice.2761.mcz
by commits＠source.squeak.org 23 Jun '20

23 Jun '20

Nicolas Cellier uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-nice.2761.mcz ==================== Summary ==================== Name: VMMaker.oscog-nice.2761 Author: nice Time: 20 June 2020, 8:11:09.897426 pm UUID: e8105e2b-a95e-4698-9a5f-939360e251b8 Ancestors: VMMaker.oscog-eem.2760 1) Revise a bit the tranformation of assignment/returns for C code generation (see below) 2) Do not try to generate SHA256Plugin, it's obsolete and absent from latest cryptography packages. In Smalltalk, every statement is an expression that can be used in other expression, assigned to variables, etc... In C, not all statements are valid expressions, or IOW, not all statements have a value. In C parlance, rvalues are the ones which can be used at the right of an assignment, lvalues the ones which can be used on the left of an assignment. While working on FFI, I had invalid code generated looking like: err = switch(atomicType) ... This is because there is brittle code for transforming some expressions, which are not generic enough. For example, we have similar TSwitchStmtListNode and TCaseStmtNode for handling #dispatchOn:in:, but not exactly same handling of both. Before this change, an overview can be given by reviewing senders of: #isSwitch #isCaseStmt This commit is an attempt to enhance/generalize handling of such non-rvalues by distributing the handling of those constructs in TParseNode hierarchy. A slight change, is that assigning/returning result of a caseOf: without otherwise clause did create a default branch with an error message and a default value for the returned expression/assigned variable. See #emitCCodeOn:addToEndOfCases:level:generator: or #emitCCodeOn:prependToEndOfCases:level:generator: The new #transformInAssignmentTo: only create the error message, but does not provide the default value. This is because type analysis might have been not yet taken place at time of transformation. Is this really needed? I don't think so. Please review! We might want to further extend the mechanism. =============== Diff against VMMaker.oscog-eem.2760 =============== Item was changed: ----- Method: TAssignmentNode>>emitStatementListExpansion:on:level:generator: (in category 'C code generation') ----- emitStatementListExpansion: stmtList on: aStream level: level generator: aCodeGen stmtList statements last = variable ifTrue: [^expression emitCCodeOn: aStream level: level generator: aCodeGen]. + (stmtList copy transformInAssignmentTo: variable) - stmtList copy - assignLastExpressionTo: variable; emitCCodeOn: aStream level: level generator: aCodeGen! Item was changed: ----- Method: TAssignmentNode>>emitStatementListExpansionAsExpression:on:level:generator: (in category 'C code generation') ----- emitStatementListExpansionAsExpression: stmtList on: aStream level: level generator: aCodeGen stmtList statements last = variable ifTrue: [^expression emitCCodeAsExpressionOn: aStream level: level generator: aCodeGen]. + (stmtList copy transformInAssignmentTo: variable) - stmtList copy - assignLastExpressionTo: variable; emitCCodeAsExpressionOn: aStream level: level generator: aCodeGen! Item was changed: ----- Method: TAssignmentNode>>emitValueExpansionOn:level:generator: (in category 'C code generation') ----- emitValueExpansionOn: aStream level: level generator: aCodeGen | stmtList lastStmt copiedStatements | self assert: (expression isSend and: [expression isValueExpansion]). stmtList := expression receiver. lastStmt := stmtList statements last. (lastStmt = variable or: [lastStmt isReturn]) ifTrue: [^expression emitCCodeOn: aStream level: level generator: aCodeGen]. + copiedStatements := stmtList copy transformInAssignmentTo: variable. - copiedStatements := stmtList copy. - copiedStatements statements - at: stmtList statements size - put: (TAssignmentNode new - setVariable: variable - expression: lastStmt). expression copy receiver: copiedStatements; emitCCodeOn: aStream level: level generator: aCodeGen! Item was added: + ----- Method: TAssignmentNode>>transformInAssignmentTo: (in category 'transformations') ----- + transformInAssignmentTo: aTVariableNode + "Avoid transforming: + x := expression + into: + x := x := expression" + + aTVariableNode = variable ifTrue: [^self]. + ^super transformInAssignmentTo: aTVariableNode! Item was changed: TParseNode subclass: #TCaseStmtNode + instanceVariableNames: 'expression firsts lasts cases otherwiseOrNil' - instanceVariableNames: 'expression firsts lasts cases' classVariableNames: '' poolDictionaries: '' category: 'VMMaker-Translation to C'! !TCaseStmtNode commentStamp: '<historical>' prior: 0! I implement the main dispatch case statements for bytecode and primitive dispatch. See TMethod classPool associationAt: #CaseStatements! Item was changed: ----- Method: TCaseStmtNode>>emitCCodeOn:level:generator: (in category 'C code generation') ----- emitCCodeOn: aStream level: level generator: aCodeGen | printMod expansions duplicates | printMod := false. (expression isVariable and: [expression name = 'currentBytecode']) ifTrue: [printMod := true. aStream nextPutAll: 'bytecodeDispatchDebugHook();'; cr; crtab: level. aCodeGen outputAsmLabel: 'bytecodeDispatch' on: aStream. aStream crtab: level]. aStream nextPutAll: 'switch ('. expression emitCCodeOn: aStream level: level generator: aCodeGen. aStream nextPutAll: ') {'; cr. expansions := aCodeGen suppressAsmLabelsWhile: [cases collect: [:case| self filterCommentsFrom: (String streamContents: [:s| case emitCCodeOn: s level: 0 generator: aCodeGen])]]. duplicates := Set new. 1 to: cases size do: [:i| (duplicates includes: i) ifFalse: [(duplicates addAll: ((i to: cases size) select: [:j| (expansions at: i) = (expansions at: j)])) do: [:k| (firsts at: k) to: (lasts at: k) do: [:caseIndex| aStream tab: level; nextPutAll: 'case '; print: caseIndex; nextPut: $:. (caseIndex > 255 and: [printMod]) ifTrue: [aStream nextPutAll: ' /*'; print: (caseIndex bitAnd: 255); nextPutAll: '*/']. aStream cr]]. (cases at: i) emitCCodeOn: aStream level: level + 1 generator: aCodeGen. aStream tab: level + 1; nextPutAll: 'break;'; cr]]. + otherwiseOrNil + ifNotNil: + [aStream + crtab: level; + nextPutAll: 'default:'; + cr. + otherwiseOrNil emitCCodeOn: aStream level: level + 1 generator: aCodeGen]. aStream tab: level; nextPut: $}! Item was added: + ----- Method: TCaseStmtNode>>isAnRValueIn: (in category 'testing') ----- + isAnRValueIn: aCodeGen + "A switch is not an rvalue" + + ^false! Item was added: + ----- Method: TCaseStmtNode>>transformInAssignmentTo: (in category 'transformations') ----- + transformInAssignmentTo: aTVariableNode + "Destructively transform the receiver so that each case is transformed into an assignment." + cases := cases collect: [:node | node copy transformInAssignmentTo: aTVariableNode]. + otherwiseOrNil := otherwiseOrNil isNil + ifTrue: [TStmtListNode new setArguments: #() statements: + {TSendNode new setSelector: #error + receiver: (TConstantNode new setValue: 'Case not found') + arguments: #()}] + ifFalse: [otherwiseOrNil copy transformInAssignmentTo: aTVariableNode]. + ^self! Item was added: + ----- Method: TGoToNode>>isAnRValueIn: (in category 'testing') ----- + isAnRValueIn: aCodeGen + "A goto is not an rvalue" + + ^false! Item was removed: - ----- Method: TMethod>>isConditionalToBeTransformedForAssignment:in: (in category 'inlining') ----- - isConditionalToBeTransformedForAssignment: aSend in: aCodeGen - "Answer if a send is of the form - e1 - ifTrue: [e2 ifTrue: [self m1] ifFalse: [self m2]] - ifFalse: [self m3] - such that at least one of the sends mN may be inlined.." - - ^(#(ifTrue:ifFalse: ifFalse:ifTrue:) includes: aSend selector) - and: [aSend args anySatisfy: - [:arg| | stmt | - self assert: arg isStmtList. - arg statements size > 1 - or: [(stmt := arg statements first) isSwitch - or: [stmt isSend - and: [(aCodeGen mayInline: stmt selector) - or: [self isConditionalToBeTransformedForAssignment: stmt in: aCodeGen]]]]]]! Item was changed: ----- Method: TMethod>>transformConditionalAssignment:in: (in category 'inlining') ----- transformConditionalAssignment: node in: aCodeGen "If possible answer the transformation of code of the form var := e1 ifTrue: [e2 ifTrue: [self m1] ifFalse: [self m2]] ifFalse: [self m3] into e1 ifTrue: [e2 ifTrue: [var := self m1] ifFalse: [var := self m2]] ifFalse: [var := self m3] + to allow inlining of m1, m2, et al. Otherwise answer nil. + Also apply to various C constructs like switch" - to allow inlining of m1, m2, et al. Otherwise answer nil." - | expr | ^(node isAssignment + and: [node expression mustTransformWhenAssignedIn: aCodeGen]) ifTrue: + [node expression copy transformInAssignmentTo: node variable]! - and: [(expr := node expression) isSend - and: [(#(ifTrue:ifFalse: ifFalse:ifTrue:) includes: expr selector) - and: [self isConditionalToBeTransformedForAssignment: expr in: aCodeGen]]]) ifTrue: - [expr copy - arguments: - (expr args collect: - [:stmtList| stmtList copy assignLastExpressionTo: node variable]); - yourself]! Item was changed: ----- Method: TMethod>>transformReturnSubExpression:toAssignmentOf:andGoto:unless:into: (in category 'inlining') ----- transformReturnSubExpression: node toAssignmentOf: exitVar andGoto: exitLabel unless: eliminateReturnSelfs into: aBinaryBlock | expr replacement | expr := node isReturn ifTrue: [node expression] ifFalse: [node]. replacement := (expr isVariable "Eliminate ^self's" and: [expr name = 'self' and: [eliminateReturnSelfs]]) ifTrue: [nil] ifFalse: [exitVar ifNil: [expr] + ifNotNil: [expr transformInAssignmentTo: (TVariableNode new setName: exitVar)]]. - ifNotNil: [TAssignmentNode new - setVariable: (TVariableNode new setName: exitVar) - expression: expr]]. node == parseTree statements last ifTrue: [aBinaryBlock value: replacement value: false] ifFalse: [replacement := replacement ifNil: [TGoToNode new setLabel: exitLabel; yourself] ifNotNil: [TStmtListNode new setArguments: #() statements: {replacement. TGoToNode new setLabel: exitLabel; yourself}; yourself]. aBinaryBlock value: replacement value: true]! Item was changed: ----- Method: TMethod>>transformReturns (in category 'type inference') ----- transformReturns + "Once the return type has been found or inferred, returns may need to be modified. - "Once the return type has been found or inferred, returns may bneed to be modified. If the return type is #void, any occurrences of ^expr must be replaced with expr. ^self. If the type is #sqInt any any occurrences of ^self are replaced with ^0." (returnType == #void or: [returnType == #sqInt]) ifFalse: [^self]. parseTree nodesWithParentsDo: [:node :parent| node isReturn ifTrue: [(node expression isVariable and: [node expression name = 'self']) ifTrue: [returnType = #sqInt ifTrue: [node setExpression: (TConstantNode new setValue: 0)]] ifFalse: [returnType = #void ifTrue: [parent replaceChild: node with: (TStmtListNode new setArguments: #() statements: {node expression. TReturnNode new setExpression: (TVariableNode new setName: 'self') yourself})]]]]! Item was added: + ----- Method: TParseNode>>isAnRValueIn: (in category 'testing') ----- + isAnRValueIn: aCodeGen + "Answer false if this node is potentially not a rvalue. + a rvalue is an expression that can occur to the right of an assignement. + In C code, not all expression can be a rvalue. + For example if() {} else {} are not rvalues, unless they can be transformed into a ()?: construct. + Likewise, while and for loops, switch statements are not possible rvalues. + This method has to take inlining into account, because a simple message send would be transformed into a function call which is an rvalue. + But if the method is inlined rather than called, this may not be the case. + Default behavior is to answer true, only notorious non-rvalues have to refine this" + + ^true + ! Item was added: + ----- Method: TParseNode>>mustTransformWhenAssignedIn: (in category 'testing') ----- + mustTransformWhenAssignedIn: aCodeGen + "Answer whether this node must be transformed when assigned to a variable + var := expr. + Not all statements can be used at the right of assignment in C (rvalues)." + + ^(self isAnRValueIn: aCodeGen) not + ! Item was added: + ----- Method: TParseNode>>transformInAssignmentTo: (in category 'transformations') ----- + transformInAssignmentTo: aTVariableNode + "Default behavior is to transform an expression into an assignement + var := expression. + This message has to be redefined in subclasses which are not rvalues." + ^TAssignmentNode new + setVariable: aTVariableNode + expression: self! Item was added: + ----- Method: TReturnNode>>isAnRValueIn: (in category 'testing') ----- + isAnRValueIn: aCodeGen + "This is not an rvalue, we cannot write: + x = return y" + + ^false! Item was added: + ----- Method: TReturnNode>>transformInAssignmentTo: (in category 'transformations') ----- + transformInAssignmentTo: aTVariableNode + "a return shall not be assigned: + x := condition ifTrue: [^nil] ifFalse: [2] + shall be transformed into: + condition ifTrue: [^nil] ifFalse: [x := 2]" + + ^self! Item was added: + ----- Method: TSendNode>>isAnRValueIn: (in category 'testing') ----- + isAnRValueIn: aCodeGen + self isConditionalSend + ifTrue: ["If all expressions of a conditional are rvalue, then the + conditional can be transformed into a ()?: construct and is + thus an rvalue" + ^ (receiver isAnRValueIn: aCodeGen) + and: [self args + allSatisfy: [:arg | arg isAnRValueIn: aCodeGen]]]. + "inlined message sends are potentially not rvalues" + ^ (aCodeGen mayInline: self selector) not! Item was added: + ----- Method: TSendNode>>mustTransformWhenAssignedIn: (in category 'transformations') ----- + mustTransformWhenAssignedIn: aCodeGen + "Answer whether this node must be transformed. + Avoid infinite transformation loops caused by unchanged nodes." + + (aCodeGen mayInline: self selector) ifTrue: [^false]. + ^super mustTransformWhenAssignedIn: aCodeGen! Item was added: + ----- Method: TSendNode>>transformInAssignmentTo: (in category 'transformations') ----- + transformInAssignmentTo: aTVariableNode + "transform a conditional: + condition ifTrue: [stmt1. stmt2] ifFalse: [stmt3. stmt4]. + into: + condition ifTrue: [stmt1. var := stmt2] ifFalse: [stmt3. var := stmt4]. + If the last expression is itself not an rvalue, it will be transformed recursively" + + self isConditionalSend ifTrue: [^self copy + arguments: + (self args collect: + [:stmtList| stmtList copy transformInAssignmentTo: aTVariableNode]); + yourself]. + "don't attempt to assign aTVariableNode with the error condition (like default switch missing)" + selector = #error ifTrue: [^self]. + ^super transformInAssignmentTo: aTVariableNode! Item was removed: - ----- Method: TStmtListNode>>assignLastExpressionTo: (in category 'transformations') ----- - assignLastExpressionTo: variableNode - "Destructively transform the receiver so that its last expression is assigned to the argument." - | index | - index := statements findLast: [:expr| (expr isGoTo or: [expr isLabel]) not]. - statements - at: index - put: (TAssignmentNode new - setVariable: variableNode - expression: (statements at: index))! Item was added: + ----- Method: TStmtListNode>>isAnRValueIn: (in category 'testing') ----- + isAnRValueIn: aCodeGen + "A list of statements is not an rvalue... + Well, in simple cases we could use comma operator (,), but don't bother here." + + ^statements size = 1 and: [statements first isAnRValueIn: aCodeGen]! Item was added: + ----- Method: TStmtListNode>>transformInAssignmentTo: (in category 'transformations') ----- + transformInAssignmentTo: aTVariableNode + "Destructively transform the receiver so that its last expression is assigned to the argument." + | index | + index := statements findLast: [:expr| (expr isGoTo or: [expr isLabel]) not]. + statements + at: index + put: ((statements at: index) copy transformInAssignmentTo: aTVariableNode). + ^self! Item was added: + ----- Method: TSwitchStmtNode>>isAnRValueIn: (in category 'testing') ----- + isAnRValueIn: aCodeGen + "A switch is not an rvalue" + + ^false! Item was added: + ----- Method: TSwitchStmtNode>>transformInAssignmentTo: (in category 'transformations') ----- + transformInAssignmentTo: aTVariableNode + "Destructively transform the receiver so that each case is transformed into an assignment." + cases := cases collect: [:pair | {pair first. pair last copy transformInAssignmentTo: aTVariableNode}]. + otherwiseOrNil := otherwiseOrNil isNil + ifTrue: [TStmtListNode new setArguments: #() statements: + {TSendNode new setSelector: #error + receiver: (TConstantNode new setValue: 'Case not found and no otherwise clause') + arguments: #()}] + ifFalse: [otherwiseOrNil copy transformInAssignmentTo: aTVariableNode]. + ^self! Item was added: + ----- Method: TVariableNode>>transformInAssignmentTo: (in category 'transformations') ----- + transformInAssignmentTo: aTVariableNode + "Avoid transforming: + x + into: + x := x" + + aTVariableNode = self ifTrue: [^self]. + ^super transformInAssignmentTo: aTVariableNode! Item was changed: ----- Method: VMMaker class>>generateVMPlugins (in category 'configurations') ----- generateVMPlugins ^VMMaker generatePluginsTo: self sourceTree, '/src' options: #() platformDir: self sourceTree, '/platforms' including:#(ADPCMCodecPlugin AsynchFilePlugin BalloonEnginePlugin B3DAcceleratorPlugin B3DEnginePlugin BMPReadWriterPlugin BitBltSimulation BochsIA32Plugin BochsX64Plugin GdbARMv6Plugin GdbARMv8Plugin CameraPlugin CroquetPlugin DeflatePlugin DropPlugin + "Cryptography Plugins:" DESPlugin DSAPlugin MD5Plugin - "Cryptography Plugins:" DESPlugin DSAPlugin MD5Plugin SHA256Plugin "FT2Plugin" FFTPlugin FileCopyPlugin FilePlugin FileAttributesPlugin Float64ArrayPlugin FloatArrayPlugin FloatMathPlugin GeniePlugin HostWindowPlugin IA32ABIPlugin ImmX11Plugin InternetConfigPlugin JPEGReadWriter2Plugin JPEGReaderPlugin JoystickTabletPlugin KlattSynthesizerPlugin LargeIntegersPlugin LocalePlugin MIDIPlugin MacMenubarPlugin Matrix2x3Plugin MiscPrimitivePlugin Mpeg3Plugin QuicktimePlugin RePlugin ScratchPlugin SecurityPlugin SerialPlugin SocketPlugin SoundCodecPlugin SoundGenerationPlugin SoundPlugin SqueakSSLPlugin StarSqueakPlugin ThreadedFFIPlugin ThreadedARM32FFIPlugin ThreadedARM64FFIPlugin ThreadedIA32FFIPlugin ThreadedX64SysVFFIPlugin ThreadedX64Win64FFIPlugin UnicodePlugin UnixAioPlugin UUIDPlugin UnixOSProcessPlugin Win32OSProcessPlugin VMProfileLinuxSupportPlugin VMProfileMacSupportPlugin WeDoPlugin XDisplayControlPlugin)!

3 5

VM Maker: VMMaker.oscog-eem.2763.mcz
by commits＠source.squeak.org 23 Jun '20

23 Jun '20

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2763.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2763 Author: eem Time: 23 June 2020, 10:37:04.443736 am UUID: a710c685-e1fa-429e-a468-07d50de0aa86 Ancestors: VMMaker.oscog-nice.2762 MiscPrimitivePlugin: fix several uses of sizeOfSTArrayFromCPrimitive: that don't check for potential failure if e.g. invoked on a CompiledMethod. Primitive infrastructure: consequently guard the various methodReturnXXX's with an assert to check that a primitive has not failed. Also make sure that the SpurNBitCoMemoryManagers do not follow any reference to a Cog method in the first field of a CompiledMethod. =============== Diff against VMMaker.oscog-nice.2762 =============== Item was changed: ----- Method: InterpreterProxy>>methodReturnBool: (in category 'stack access') ----- methodReturnBool: boolean "Sets the return value for a method" + self deny: self failed. self pop: argumentCount+1 thenPushBool: boolean. ^0! Item was changed: ----- Method: InterpreterProxy>>methodReturnFloat: (in category 'stack access') ----- methodReturnFloat: aFloat "Sets the return value for a method" <var: 'aFloat' type: #double> + self deny: self failed. self pop: argumentCount+1 thenPushFloat: aFloat. ^0! Item was changed: ----- Method: InterpreterProxy>>methodReturnInteger: (in category 'stack access') ----- methodReturnInteger: integer "Sets the return value for a method" + self deny: self failed. self pop: argumentCount+1 thenPushInteger: integer. ^0! Item was changed: ----- Method: InterpreterProxy>>methodReturnReceiver (in category 'stack access') ----- methodReturnReceiver "Sets the return value for a method" + self deny: self failed. self pop: argumentCount. ^0! Item was changed: ----- Method: InterpreterProxy>>methodReturnString: (in category 'stack access') ----- methodReturnString: aCString "Attempt to answer a ByteString for a given C string as the result of a primitive." <var: 'aCString' type: #'char *'> + self deny: self failed. aCString ifNil: [primFailCode := PrimErrOperationFailed] ifNotNil: [(self stringForCString: aCString) ifNil: [primFailCode := PrimErrNoMemory] ifNotNil: [:result| self pop: argumentCount+1 thenPush: result]]. ^0! Item was changed: ----- Method: InterpreterProxy>>methodReturnValue: (in category 'stack access') ----- methodReturnValue: oop "Sets the return value for a method" + self deny: self failed. self pop: argumentCount+1 thenPush: oop. ^0! Item was changed: ----- Method: MiscPrimitivePlugin>>primitiveCompareString (in category 'primitives') ----- primitiveCompareString "ByteString (class) compare: string1 with: string2 collated: order" <export: true> | len1 len2 order string1 string2 orderOop string1Oop string2Oop | <var: 'order' type: #'unsigned char *'> <var: 'string1' type: #'unsigned char *'> <var: 'string2' type: #'unsigned char *'> orderOop := interpreterProxy stackValue: 0. string2Oop := interpreterProxy stackValue: 1. string1Oop := interpreterProxy stackValue: 2. ((interpreterProxy isBytes: orderOop) and: [(interpreterProxy isBytes: string2Oop) and: [interpreterProxy isBytes: string1Oop]]) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. order := interpreterProxy firstIndexableField: orderOop. (interpreterProxy sizeOfSTArrayFromCPrimitive: order) < 256 ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. string1 := interpreterProxy firstIndexableField: string1Oop. string2 := interpreterProxy firstIndexableField: string2Oop. len1 := interpreterProxy sizeOfSTArrayFromCPrimitive: string1. len2 := interpreterProxy sizeOfSTArrayFromCPrimitive: string2. + interpreterProxy failed ifTrue: "the sizeOfSTArrayFromCPrimitive:'s fail for e.g. CompiledMethod" + [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. 0 to: (len1 min: len2) - 1 do: [ :i | | c1 c2 | c1 := order at: (string1 at: i). c2 := order at: (string2 at: i). c1 = c2 ifFalse: [^interpreterProxy methodReturnInteger: (c1 < c2 ifTrue: [1] ifFalse: [3])]]. interpreterProxy methodReturnInteger: (len1 = len2 ifTrue: [2] ifFalse: [len1 < len2 ifTrue: [1] ifFalse: [3]])! Item was changed: ----- Method: MiscPrimitivePlugin>>primitiveCompressToByteArray (in category 'primitives') ----- primitiveCompressToByteArray "Bitmap compress: bm toByteArray: ba" <export: true> | bm ba eqBytes i j k lowByte size destSize word | <var: 'ba' type: #'unsigned char *'> <var: 'bm' type: #'int *'> bm := self cCode: [interpreterProxy arrayValueOf: (interpreterProxy stackValue: 1)] inSmalltalk: [interpreterProxy cCoerce: (interpreterProxy arrayValueOf: (interpreterProxy stackValue: 1)) to: #'int *']. interpreterProxy failed ifTrue: [^nil]. (interpreterProxy isBytes: (interpreterProxy stackValue: 0)) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. (interpreterProxy isOopImmutable: (interpreterProxy stackValue: 0)) ifTrue: [^interpreterProxy primitiveFailFor: PrimErrNoModification]. ba := interpreterProxy firstIndexableField: (interpreterProxy stackValue: 0). size := interpreterProxy sizeOfSTArrayFromCPrimitive: bm. destSize := interpreterProxy sizeOfSTArrayFromCPrimitive: ba. + interpreterProxy failed ifTrue: "the sizeOfSTArrayFromCPrimitive:'s fail for e.g. CompiledMethod" + [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. destSize < ((size * 4) + 7 + (size // 1984 * 3)) ifTrue: [^interpreterProxy primitiveFailFor: PrimErrUnsupported]. "Size may be OK but we don't know, hence fail with unsupported" i := self encodeInt: size in: ba at: 0. k := 0. [k < size] whileTrue: [word := bm at: k. lowByte := word bitAnd: 255. eqBytes := (word >> 8 bitAnd: 255) = lowByte and: [(word >> 16 bitAnd: 255) = lowByte and: [(word >> 24 bitAnd: 255) = lowByte]]. j := k. [j + 1 < size and: [word = (bm at: j + 1)]] whileTrue: [j := j + 1]. j > k ifTrue: [eqBytes ifTrue: [i := self encodeInt: j - k + 1 * 4 + 1 in: ba at: i. ba at: i put: lowByte. i := i + 1] ifFalse: [i := self encodeInt: j - k + 1 * 4 + 2 in: ba at: i. i := self encodeBytesOf: word in: ba at: i]. k := j + 1] ifFalse: [eqBytes ifTrue: [i := self encodeInt: 1 * 4 + 1 in: ba at: i. ba at: i put: lowByte. i := i + 1. k := k + 1] ifFalse: [[j + 1 < size and: [(bm at: j) ~= (bm at: j + 1)]] whileTrue: [j := j + 1]. j + 1 = size ifTrue: [j := j + 1]. i := self encodeInt: j - k * 4 + 3 in: ba at: i. k to: j - 1 by: 1 do: [ :m | i := self encodeBytesOf: (bm at: m) in: ba at: i]. k := j]]]. interpreterProxy methodReturnInteger: i! Item was changed: ----- Method: MiscPrimitivePlugin>>primitiveConvert8BitSigned (in category 'primitives') ----- primitiveConvert8BitSigned "SampledSound (class) convert8bitSignedFrom: aByteArray to16Bit: aSoundBuffer" <export: true> | aByteArray aSoundBuffer arraySize byteArrayOop soundBufferOop | <var: 'aByteArray' type: #'unsigned char *'> <var: 'aSoundBuffer' type: #'unsigned short *'> byteArrayOop := interpreterProxy stackValue: 1. (interpreterProxy isBytes: byteArrayOop) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. aByteArray := interpreterProxy firstIndexableField: byteArrayOop. soundBufferOop := interpreterProxy stackValue: 0. + (interpreterProxy isOopImmutable: soundBufferOop) ifTrue: + [^interpreterProxy primitiveFailFor: PrimErrNoModification]. aSoundBuffer := self cCode: [interpreterProxy arrayValueOf: soundBufferOop] inSmalltalk: [interpreterProxy cCoerce: (interpreterProxy arrayValueOf: soundBufferOop) to: #'unsigned short *']. - interpreterProxy failed ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. - (interpreterProxy isOopImmutable: soundBufferOop) ifTrue: - [^interpreterProxy primitiveFailFor: PrimErrNoModification]. arraySize := interpreterProxy sizeOfSTArrayFromCPrimitive: aByteArray. + interpreterProxy failed ifTrue: + [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. (interpreterProxy byteSizeOf: soundBufferOop) < (2 * arraySize) ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. 0 to: arraySize - 1 do: [ :i | | s | s := aByteArray at: i. aSoundBuffer at: i put: (s > 127 ifTrue: [s - 256 bitShift: 8] ifFalse: [s bitShift: 8])]. interpreterProxy methodReturnReceiver! Item was changed: ----- Method: MiscPrimitivePlugin>>primitiveDecompressFromByteArray (in category 'primitives') ----- primitiveDecompressFromByteArray "Bitmap decompress: bm fromByteArray: ba at: index" <export: true> | bm ba index i anInt code data end k n pastEnd | <var: 'ba' type: #'unsigned char *'> <var: 'bm' type: #'int *'> <var: 'anInt' type: #'unsigned int'> <var: 'code' type: #'unsigned int'> <var: 'data' type: #'unsigned int'> <var: 'n' type: #'unsigned int'> bm := self cCode: [interpreterProxy arrayValueOf: (interpreterProxy stackValue: 2)] inSmalltalk: [interpreterProxy cCoerce: (interpreterProxy arrayValueOf: (interpreterProxy stackValue: 2)) to: #'int *']. (interpreterProxy isOopImmutable: (interpreterProxy stackValue: 2)) ifTrue: [^interpreterProxy primitiveFailFor: PrimErrNoModification]. (interpreterProxy isBytes: (interpreterProxy stackValue: 1)) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. ba := interpreterProxy firstIndexableField: (interpreterProxy stackValue: 1). index := interpreterProxy stackIntegerValue: 0. - interpreterProxy failed ifTrue: [^nil]. - i := index - 1. - k := 0. end := interpreterProxy sizeOfSTArrayFromCPrimitive: ba. pastEnd := interpreterProxy sizeOfSTArrayFromCPrimitive: bm. + interpreterProxy failed ifTrue: + [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. + i := index - 1. + k := 0. [i < end] whileTrue: [anInt := ba at: i. i := i + 1. anInt <= 223 ifFalse: [anInt <= 254 ifTrue: [anInt := anInt - 224 * 256 + (ba at: i). i := i + 1] ifFalse: [anInt := 0. 1 to: 4 by: 1 do: [ :j | anInt := (anInt bitShift: 8) + (ba at: i). i := i + 1]]]. n := anInt >> 2. k + n > pastEnd ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]. code := anInt bitAnd: 3. "code = 0 ifTrue: [nil]." code = 1 ifTrue: [data := ba at: i. i := i + 1. data := data bitOr: (data bitShift: 8). data := data bitOr: (data bitShift: 16). 1 to: n do: [ :j | bm at: k put: data. k := k + 1]]. code = 2 ifTrue: [data := 0. 1 to: 4 do: [ :j | data := (data bitShift: 8) bitOr: (ba at: i). i := i + 1]. 1 to: n do: [ :j | bm at: k put: data. k := k + 1]]. code = 3 ifTrue: [1 to: n do: [ :m | data := 0. 1 to: 4 do: [ :j | data := (data bitShift: 8) bitOr: (ba at: i). i := i + 1]. bm at: k put: data. k := k + 1]]]. interpreterProxy pop: interpreterProxy methodArgumentCount! Item was changed: ----- Method: MiscPrimitivePlugin>>primitiveFindFirstInString (in category 'primitives') ----- primitiveFindFirstInString "ByteString (class) findFirstInString: aString inSet: inclusionMap startingAt: start" <export: true> | aString i inclusionMap stringSize aStringOop inclusionMapOop | <var: 'aString' type: #'unsigned char *'> <var: 'inclusionMap' type: #'unsigned char *'> aStringOop := interpreterProxy stackValue: 2. (interpreterProxy isBytes: aStringOop) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. inclusionMapOop := interpreterProxy stackValue: 1. (interpreterProxy isBytes: inclusionMapOop) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. i := interpreterProxy stackIntegerValue: 0. + interpreterProxy failed ifTrue: + [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. - interpreterProxy failed ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. i := i - 1. "Convert to 0-based index." i < 0 ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]. inclusionMap := interpreterProxy firstIndexableField: inclusionMapOop. (interpreterProxy sizeOfSTArrayFromCPrimitive: inclusionMap) ~= 256 ifTrue: [^interpreterProxy methodReturnInteger: 0]. aString := interpreterProxy firstIndexableField: aStringOop. stringSize := interpreterProxy sizeOfSTArrayFromCPrimitive: aString. + interpreterProxy failed ifTrue: "the sizeOfSTArrayFromCPrimitive:'s fail for e.g. CompiledMethod" + [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. [i < stringSize and: [(inclusionMap at: (aString at: i)) = 0]] whileTrue: [i := i + 1]. interpreterProxy methodReturnInteger: (i >= stringSize ifTrue: [0] ifFalse: [i + 1])! Item was changed: ----- Method: MiscPrimitivePlugin>>primitiveFindSubstring (in category 'primitives') ----- primitiveFindSubstring "ByteString findSubstring: key in: body startingAt: start matchTable: matchTable" <export: true> + | body key keySize bodySize matchTable start bodyOop keyOop matchTableOop | - | body key keySize matchTable start bodyOop keyOop matchTableOop | <var: #key type: #'unsigned char *'> <var: #body type: #'unsigned char *'> <var: #matchTable type: #'unsigned char *'> keyOop := interpreterProxy stackValue: 3. (interpreterProxy isBytes: keyOop) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. bodyOop := interpreterProxy stackValue: 2. (interpreterProxy isBytes: bodyOop) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. start := interpreterProxy stackIntegerValue: 1. interpreterProxy failed ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. matchTableOop := interpreterProxy stackValue: 0. (interpreterProxy isBytes: matchTableOop) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. matchTable := interpreterProxy firstIndexableField: matchTableOop. (interpreterProxy sizeOfSTArrayFromCPrimitive: matchTable) < 256 ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. key := interpreterProxy firstIndexableField: keyOop. (keySize := interpreterProxy sizeOfSTArrayFromCPrimitive: key) > 0 ifTrue: [keySize := keySize - 1. "adjust for zero relative indexes" start := start - 1 max: 0. "adjust for zero relative indexes" + body := interpreterProxy firstIndexableField: bodyOop. + bodySize := interpreterProxy sizeOfSTArrayFromCPrimitive: body. + interpreterProxy failed ifTrue: "the sizeOfSTArrayFromCPrimitive:'s fail for e.g. CompiledMethod" + [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. + start to: bodySize - 1 - keySize do: - body := interpreterProxy firstIndexableField: bodyOop. - start to: (interpreterProxy sizeOfSTArrayFromCPrimitive: body) - 1 - keySize do: [ :startIndex | | index | index := 0. [(matchTable at: (body at: startIndex + index)) = (matchTable at: (key at: index))] whileTrue: [index = keySize ifTrue: [^interpreterProxy methodReturnInteger: startIndex + 1]. index := index + 1]]]. ^interpreterProxy methodReturnInteger: 0! Item was changed: ----- Method: MiscPrimitivePlugin>>primitiveIndexOfAsciiInString (in category 'primitives') ----- primitiveIndexOfAsciiInString "ByteString indexOfAscii: anInteger inString: aString startingAt: start" <export: true> + | integerOop startOop anInteger aString start stringSize stringOop | - | anInteger aString start stringSize aStringOop | <var: #aString type: #'unsigned char *'> + integerOop := interpreterProxy stackValue: 2. + stringOop := interpreterProxy stackValue: 1. + startOop := interpreterProxy stackValue: 0. + ((interpreterProxy isIntegerObject: integerOop) + and: [(interpreterProxy isIntegerObject: startOop) + and: [(interpreterProxy isBytes: stringOop) + and: [interpreterProxy isWordsOrBytes: stringOop]]]) ifFalse: "sizeOfSTArrayFromCPrimitive: is defined only for words or bytes" - anInteger := interpreterProxy stackIntegerValue: 2. - interpreterProxy failed ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. + (start := interpreterProxy integerValueOf: startOop) >= 1 ifFalse: + [^interpreterProxy primitiveFailFor: PrimErrBadIndex]. + anInteger := interpreterProxy integerValueOf: integerOop. + aString := interpreterProxy firstIndexableField: stringOop. - aStringOop := interpreterProxy stackValue: 1. - (interpreterProxy isBytes: aStringOop) ifFalse: - [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. - start := interpreterProxy stackIntegerValue: 0. - interpreterProxy failed ifTrue: - [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. - start >= 1 ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]. - aString := interpreterProxy firstIndexableField: aStringOop. stringSize := interpreterProxy sizeOfSTArrayFromCPrimitive: aString. + self deny: interpreterProxy failed. start - 1 to: stringSize - 1 do: + [:pos | - [ :pos | (aString at: pos) = anInteger ifTrue: [^interpreterProxy methodReturnInteger: pos + 1]]. ^interpreterProxy methodReturnInteger: 0! Item was changed: ----- Method: MiscPrimitivePlugin>>primitiveStringHash (in category 'primitives') ----- primitiveStringHash "ByteArray (class) hashBytes: aByteArray startingWith: speciesHash" <export: true> | aByteArray hash byteArrayOop | <var: 'aByteArray' type: #'unsigned char *'> <var: 'hash' type: #'unsigned int'> hash := interpreterProxy stackIntegerValue: 0. interpreterProxy failed ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. byteArrayOop := interpreterProxy stackValue: 1. + ((interpreterProxy isBytes: byteArrayOop) + and: [interpreterProxy isWordsOrBytes: byteArrayOop]) ifFalse: "filters out CompiledMethods" - (interpreterProxy isBytes: byteArrayOop) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. aByteArray := interpreterProxy firstIndexableField: byteArrayOop. 0 to: (interpreterProxy sizeOfSTArrayFromCPrimitive: aByteArray) - 1 do: [ :pos | hash := hash + (aByteArray at: pos) * 16r19660D ]. interpreterProxy methodReturnInteger: (hash bitAnd: 16r0FFFFFFF)! Item was changed: ----- Method: MiscPrimitivePlugin>>primitiveTranslateStringWithTable (in category 'primitives') ----- primitiveTranslateStringWithTable "ByteString (class) translate: aString from: start to: stop table: table" <export: true> | aString start stop table aStringOop tableOop | <var: #table type: #'unsigned char *'> <var: #aString type: #'unsigned char *'> aStringOop := interpreterProxy stackValue: 3. (interpreterProxy isBytes: aStringOop) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. (interpreterProxy isOopImmutable: aStringOop) ifTrue: [^interpreterProxy primitiveFailFor: PrimErrNoModification]. start := interpreterProxy stackIntegerValue: 2. - interpreterProxy failed ifTrue: - [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. stop := interpreterProxy stackIntegerValue: 1. interpreterProxy failed ifTrue: + [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. - [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. tableOop := interpreterProxy stackValue: 0. (interpreterProxy isBytes: tableOop) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. aString := interpreterProxy firstIndexableField: aStringOop. (start >= 1 and: [stop <= (interpreterProxy sizeOfSTArrayFromCPrimitive: aString)]) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]. table := interpreterProxy firstIndexableField: tableOop. (interpreterProxy sizeOfSTArrayFromCPrimitive: table) < 256 ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. + interpreterProxy failed ifTrue: + [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. start - 1 to: stop - 1 do: [ :i | aString at: i put: (table at: (aString at: i))]. interpreterProxy methodReturnReceiver! Item was added: + ----- Method: Spur32BitCoMemoryManager>>followForwardedObjectFields:toDepth: (in category 'as yet unclassified') ----- + followForwardedObjectFields: objOop toDepth: depth + "Follow pointers in the object to depth. + Answer if any forwarders were found. + How to avoid cyclic structures?? A temporary mark bit? eem 6/22/2020 no need since depth is always finite." + <api> + <inline: false> + | oop found fmt | + found := false. + self assert: ((self isPointers: objOop) or: [self isOopCompiledMethod: objOop]). + fmt := self formatOf: objOop. + "It is essential to skip the first field of a method because it may be a + reference to a Cog method in the method zone, not a real object at all." + ((self isCompiledMethodFormat: fmt) + ifTrue: [1] + ifFalse: [0]) + to: (self numPointerSlotsOf: objOop format: fmt) - 1 + do: [:i| + oop := self fetchPointer: i ofObject: objOop. + (self isNonImmediate: oop) ifTrue: + [(self isForwarded: oop) ifTrue: + [found := true. + oop := self followForwarded: oop. + self storePointer: i ofObject: objOop withValue: oop]. + (depth > 0 + and: [(self hasPointerFields: oop) + and: [self followForwardedObjectFields: oop toDepth: depth - 1]]) ifTrue: + [found := true]]]. + ^found! Item was added: + ----- Method: Spur64BitCoMemoryManager>>followForwardedObjectFields:toDepth: (in category 'forwarding') ----- + followForwardedObjectFields: objOop toDepth: depth + "Follow pointers in the object to depth. + Answer if any forwarders were found. + How to avoid cyclic structures?? A temporary mark bit? eem 6/22/2020 no need since depth is always finite." + <api> + <inline: false> + | oop found fmt | + found := false. + self assert: ((self isPointers: objOop) or: [self isOopCompiledMethod: objOop]). + fmt := self formatOf: objOop. + "It is essential to skip the first field of a method because it may be a + reference to a Cog method in the method zone, not a real object at all." + ((self isCompiledMethodFormat: fmt) + ifTrue: [1] + ifFalse: [0]) + to: (self numPointerSlotsOf: objOop format: fmt) - 1 + do: [:i| + oop := self fetchPointer: i ofObject: objOop. + (self isNonImmediate: oop) ifTrue: + [(self isForwarded: oop) ifTrue: + [found := true. + oop := self followForwarded: oop. + self storePointer: i ofObject: objOop withValue: oop]. + (depth > 0 + and: [(self hasPointerFields: oop) + and: [self followForwardedObjectFields: oop toDepth: depth - 1]]) ifTrue: + [found := true]]]. + ^found! Item was changed: ----- Method: SpurMemoryManager>>followForwardedObjectFields:toDepth: (in category 'forwarding') ----- followForwardedObjectFields: objOop toDepth: depth "Follow pointers in the object to depth. Answer if any forwarders were found. + How to avoid cyclic structures?? A temporary mark bit? eem 6/22/2020 no need since depth is always finite." - How to avoid cyclic structures?? A temproary mark bit?" <api> <inline: false> | oop found | found := false. self assert: ((self isPointers: objOop) or: [self isOopCompiledMethod: objOop]). 0 to: (self numPointerSlotsOf: objOop) - 1 do: [:i| oop := self fetchPointer: i ofObject: objOop. (self isNonImmediate: oop) ifTrue: [(self isForwarded: oop) ifTrue: [found := true. oop := self followForwarded: oop. self storePointer: i ofObject: objOop withValue: oop]. (depth > 0 and: [(self hasPointerFields: oop) and: [self followForwardedObjectFields: oop toDepth: depth - 1]]) ifTrue: [found := true]]]. ^found! Item was changed: ----- Method: SpurMemoryManager>>numPointerSlotsOf: (in category 'object access') ----- numPointerSlotsOf: objOop "Answer the number of pointer fields in the given object. Works with CompiledMethods, as well as ordinary objects." <api> <inline: true> + | fmt | - | fmt contextSize numLiterals header | fmt := self formatOf: objOop. + ^self numPointerSlotsOf: objOop format: fmt! - fmt <= self lastPointerFormat ifTrue: - [(fmt = self indexablePointersFormat - and: [self isContextNonImm: objOop]) ifTrue: - ["contexts end at the stack pointer" - contextSize := coInterpreter fetchStackPointerOf: objOop. - ^CtxtTempFrameStart + contextSize]. - ^self numSlotsOf: objOop "all pointers"]. - fmt = self forwardedFormat ifTrue: [^1]. - fmt < self firstCompiledMethodFormat ifTrue: [^0]. "no pointers" - - "CompiledMethod: contains both pointers and bytes" - header := self methodHeaderOf: objOop. - numLiterals := self literalCountOfMethodHeader: header. - ^numLiterals + LiteralStart! Item was added: + ----- Method: SpurMemoryManager>>numPointerSlotsOf:format: (in category 'object access') ----- + numPointerSlotsOf: objOop format: fmt + "Answer the number of pointer fields in the given object. + Works with CompiledMethods, as well as ordinary objects." + <inline: #always> + | contextSize numLiterals header | + fmt <= self lastPointerFormat ifTrue: + [(fmt = self indexablePointersFormat + and: [self isContextNonImm: objOop]) ifTrue: + ["contexts end at the stack pointer" + contextSize := coInterpreter fetchStackPointerOf: objOop. + ^CtxtTempFrameStart + contextSize]. + ^self numSlotsOf: objOop "all pointers"]. + fmt = self forwardedFormat ifTrue: [^1]. + fmt < self firstCompiledMethodFormat ifTrue: [^0]. "no pointers" + + "CompiledMethod: contains both pointers and bytes" + header := self methodHeaderOf: objOop. + numLiterals := self literalCountOfMethodHeader: header. + ^numLiterals + LiteralStart! Item was changed: ----- Method: StackInterpreter>>methodReturnBool: (in category 'plugin primitive support') ----- methodReturnBool: boolean "Sets the return value for a method. In the CoInterpreter we replace the cumbersome primResult machinery." + self deny: self failed. self pop: argumentCount+1 thenPushBool: boolean. ^0! Item was changed: ----- Method: StackInterpreter>>methodReturnFloat: (in category 'plugin primitive support') ----- methodReturnFloat: aFloat "Sets the return value for a method." <var: 'aFloat' type: #double> + self deny: self failed. self pop: argumentCount+1 thenPushFloat: aFloat. ^0! Item was changed: ----- Method: StackInterpreter>>methodReturnInteger: (in category 'plugin primitive support') ----- methodReturnInteger: integer "Sets the return value for a method. In the CoInterpreter we replace the cumbersome primResult machinery." + self deny: self failed. self pop: argumentCount+1 thenPushInteger: integer. ^0! Item was changed: ----- Method: StackInterpreter>>methodReturnReceiver (in category 'plugin primitive support') ----- methodReturnReceiver "Sets the return value for a method" + self deny: self failed. self pop: argumentCount. ^0! Item was changed: ----- Method: StackInterpreter>>methodReturnString: (in category 'plugin primitive support') ----- methodReturnString: aCString "Attempt to answer a ByteString for a given C string as the result of a primitive." <var: 'aCString' type: #'char *'> + self deny: self failed. aCString ifNil: [primFailCode := PrimErrOperationFailed] ifNotNil: [(self stringForCString: aCString) ifNil: [primFailCode := PrimErrNoMemory] ifNotNil: [:result| self pop: argumentCount+1 thenPush: result]]. ^0! Item was changed: ----- Method: StackInterpreter>>methodReturnValue: (in category 'plugin primitive support') ----- methodReturnValue: oop "Sets the return value for a method. In the CoInterpreter we replace the cumbersome primResult machinery." + self deny: self failed. self pop: argumentCount+1 thenPush: oop. ^0!

1 0

Re: [Vm-dev] [squeak-dev] FFI ExternalTypeAlias
by Nicolas Cellier 22 Jun '20

22 Jun '20

Err, I move this thread to Opensmalltalk VM dev, because it is not Squeak specific! Le ven. 19 juin 2020 à 15:10, Nicolas Cellier < nicolas.cellier.aka.nice(a)gmail.com> a écrit : > Hi Marcel, > thanks for your vote. Anyone else? > > Le ven. 19 juin 2020 à 09:30, Marcel Taeumel <marcel.taeumel(a)hpi.de> a > écrit : > >> Hi Nicolas, hi all! :-) >> >> > Type alias are subclasses of ExternalStructure. >> >> And with it, they get their own instance of ExternalType, which is >> managed in the classVar StructTypes. Let's call them struct type. >> >> > Now we have another mean by adding a class side method in ExternalType. >> >> That kind of aliasing is for compile-time type referencing only -- such >> as in FFI calls (i.e. <apicall:...> pragmas) or struct-field definitions >> (i.e. #fields). (And soon <callback: ...> if I have the first version of >> FFI-Callback to show you :) >> >> Because those aliases become fully transparent after compiling the method >> for the FFI call into an instance of ExternalLibraryFunction and after >> compiling the field specs of external structures into compiledSpec for >> struct types. >> >> For example, on my machine in 32-bit Squeak, a 'size_t' becomes a 'long', >> which is Squeak FFI term for 'int'. :-) See #ffiLongVsInt. And 'int32_t' >> also becomes a 'long'. So, it just translates C vocabulary into Squeak FFI >> vocabulary. Nothing more. Nothing less. >> >> Having that, please do not use class-side methods in ExternalType to >> alias a (complex) struct type. Use them only for renaming atomic types. >> Please. We may want to add checks to enforce that. >> >> I suppose that this discussion focuses on type aliases that are >> represented as subclasses of ExternalStructure (or ExternalTypeAlias) and >> thus get their own struct type. So, let's ignore this other mechanism for >> now. >> >> > This has one advantage: type safety. You cannot pass a Foo to a >> function expecting a Bar, even if they both alias int... >> >> Yes! So, we are now talking about type aliases to atomic types. The >> struct type you get when aliasing a 'char' as Foo, for example, looks like >> this: >> >> (...forgive my "creative" representation of WordArray here...) >> >> compiledSpec: 0A 04 00 01 >> referentClass: Foo >> >> How does the atomic type for 'char' look like? >> >> compiledSpec: 0A 04 00 01 >> referentClass: nil >> >> Consequently, argument coercing will fail if you pass a 'char' when a >> 'Foo' is expected. Because the referentClass does not match --- even if the >> compiledSpec does match. >> >> > But this has one major drawback: with current FFI, you cannot pass a >> Smalltalk Integer, to a method expecting a Bar, even if Bar is an alias for >> an integer type... >> >> That's correct. If the origin of such an argument is from within the >> image, you have to wrap it. But when returned from another call ... well >> ... that wrapping should have happened in the plugin ... But read on! :-) >> >> > FFI plugin is clever enough to recognize an atomic type alias and >> simply return a Smalltalk Integer... >> > So it's not Bar all the way down, I have to manually wrap Bar... >> > This is not consistent. >> >> Uhh! That's a bug. The FFI Plugin must take a look at referentClass >> because it does so for argument coercing. >> >> Now I understand why the code generation of struct-field accessors was so >> apparently broken for me. I changed that so that having an alias type as >> part of a larger struct will automatically wrap that for you into the alias >> structure. :-) Even if you are just aliasing a plain 'int' ... or 'long' >> ... Ha ha. ;-) #ffiLongVsInt. >> >> It should be "Bar all the way down". Definitely. >> >> > If we return an int, we must accept an int, otherwise, we cannot chain >> FFI calls... >> >> Well, not for type aliases. I would like keep the path of type safety >> here, you mentioned above. >> >> Just fix the FFI plugin to respect referentClass when packaging the >> return value. >> >> > I could use the lightweight alias instead, [...] >> >> Please don't. See above. Those "lightweight alias" are for renaming >> atomic types only. Let's keep it simple and try to address you concern here >> with struct types and ExternalTypeAlias. :-) >> >> > there was another usage where it was convenient to use >> ExternalTypeAlias: enum. >> > Indeed, I simply defined all enum symbols as class side method. >> >> I like that! It reads like a next step for ExternalPool. Once you have >> extracted the constant values from header files, and once you have those >> values for your platform in classVars in your external pool, use that pool >> to define enums through ExternalStructure. >> >> Like this: >> >> ExternalTypeAlias subclass: #MyEnumBar >> instanceVariableNames: '' >> classVariableNames: '' >> poolDictionaries: 'HDF5Pool' >> category: 'HDF5' >> >> MyEnumBar class >> #poolFields >> " >> self defineFields. >> " >> ^ #( >> (beg HDF5_BEG) >> (mid HDF5_MID) >> (end HDF5_END) >> ) >> >> Note that HDF5_BEG etc. are from the HDF5Pool, which is managed via >> external-pool definitions. See class comment in ExternalPool to get started. >> >> Note that #poolFields would translate to class-side methods as you >> suggested. >> >> > If I use a simpler alias, where are those ids going to? >> >> Please don't. See above. :-) >> >> > IMO we cannot keep status quo in the plugin, we gotta to make the >> inputs/outputs behave consistently. >> >> Absolutely! >> >> > - should a function expecting an ExternalTypeAlias of atomic type >> accept an immediate value of compatible type? >> >> Considering type safety, I think not. >> >> Well ... since this is a convenience issue and thus not about saving >> run-time cost ... What about adding a callback into the image to react on >> FFIErrorCoercionFailed? Maybe the selector for such a callback could be >> stored in ExternalLibraryFunction since this is accessible to the plugin >> anyway? >> >> <apicall: void 'foo' (MyInt YourInt in) ifFailCoerceVia: #wrapInt: > >> >> ... would it be possible? Like that #doesNotUnderstand: callback? >> >> I would love to do ad-hoc packaging of arguments. (Also thinking about >> FFI-Callback. But ignore me here :) >> >> > - should a function returning an ExternalTypeAlias of atomic type >> instantiate the Alias? >> >> Yes, please! See above. >> >> If you want to trade type safety in for a performance gain, just use a >> "lightweight alias" as explained above. And package that return value >> manually. >> >> Best, >> Marcel >> >> Am 18.06.2020 21:03:53 schrieb Nicolas Cellier < >> nicolas.cellier.aka.nice(a)gmail.com>: >> Hi all, >> following the question of Marcel about usage of ExternalTypeAlias: >> >> Type alias are subclasses of ExternalStructure. >> I used them in HDF5 because there was no other means to define an alias >> at the time. >> Now we have another mean by adding a class side method in ExternalType (I >> would have rather imagined the usage of some annotation to get a >> declarative style) >> >> This has one advantage: type safety. You cannot pass a Foo to a function >> expecting a Bar, even if they both alias int... >> >> But this has one major drawback: with current FFI, you cannot pass a >> Smalltalk Integer, to a method expecting a Bar, even if Bar is an alias for >> an integer type... >> >> Thus, you have to wrap every Bar argument into a Bar instance... >> Gasp, this is going too far... >> >> What about functions returning such alias? >> Function returning struct by value allocate a struct, but it's not the >> case here, FFI plugin is clever enough to recognize an atomic type alias >> and simply return a Smalltalk Integer... >> So it's not Bar all the way down, I have to manually wrap Bar... >> This is not consistent. >> If we return an int, we must accept an int, otherwise, we cannot chain >> FFI calls... >> >> I could use the lightweight alias instead, but there was another usage >> where it was convenient to use ExternalTypeAlias: enum. >> Indeed, I simply defined all enum symbols as class side method. For >> example for enum bar { beg=0, mid=1, end=2 }; I simply create a type Bar >> aliasing int and having class side methods beg ^0, mid ^1, end ^2. >> This way, I normally can pass a Bar mid to an external function. >> (currently, we must defne mid ^Bar new value: 1; yourself) >> >> If I use a simpler alias, where are those ids going to? >> >> IMO we cannot keep statu quo in the plugin, we gotta to make the >> inputs/outputs behave consistently. >> The choice is this one: >> - should a function expecting an ExternalTypeAlias of atomic type accept >> an immediate value of compatible type? (the permissive implementation) >> - should a function returning an ExternalTypeAlias of atomic type >> instantiate the Alias? (the typesafe implementation, with higher runtime >> cost due to pressure on GC) >> >> >> >>

2 12

FFI Plugin | Proposal: Add #doesNotCoerce:for: (like #doesNotUnderstand:)
by Marcel Taeumel 22 Jun '20

22 Jun '20

Hi all! We have #doesNotUnderstand:, which is sent to the receiver when a message cannot be understood. Default reaction in Object is to raise MessageNotUnderstood exception. What if we could have a similar mechanism for FFI calls: #doesNotCoerce:for:. The receiver would be the one that made that call, should be an instance of ExternalLibrary, but could be any object. The arguments would be a pair of (argObject, argType) and the message (like the argument for doesNotUnderstand:) that represents the FFI call. The pair of (argObject, argType) could be expressed as FFICallArgument: FFICallArgument argObject ... <Object> argType ... <ExternalType> I suppose that such a new class would have to be reserved in the special objects array. An alternative would be to just use Array. Keep it simple. ;-) Default reaction could be to implement #doesNotCoerce:for: in Object (as *FFI-Kernel extension) to raise FFICallArgumentNotCoerced exception (to be implemented). Also, we could implement manual coercion in ExternaLibrary to, for example, wrap atomics into their aliasing structures. ExternalLibrary >> #doesNotCoerce: callArg for: message | argObject argType argIndex wrappedArg | argObject := callArg first. "or argObject accessor" argType := callArg second. "or argType accessor" argIndex := message arguments indexOf: argObject. wrappedArg := argType referentClass fromHandle: argObject. message arguments beWritableObject. "Just in case ;-)" message at: argIndex put: wrappedArg. ^ message sendTo: self Please share your thoughts. :-) Best, Marcel

3 12

[OpenSmalltalk/opensmalltalk-vm] OpenSSL 1.0.2 end of support from 1 Jan 2020 (#455)
by Pierce Ng 22 Jun '20

22 Jun '20

As per https://www.openssl.org/policies/releasestrat.html. My fork has an [update3p branch](https://github.com/PierceNg/opensmalltalk-vm/tree/pierce_update3p) that builds with OpenSSL 1.1.1d and also related minor fixes for one or some of the Pharo mvm. -- You are receiving this because you are subscribed to this thread. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/issues/455

3 7

Re: [Vm-dev] [OpenSmalltalk/opensmalltalk-vm] Win32/64: Make the B3DAcceleratorPlugin an external plugin as it is on the (920248d)
by Nicolas Cellier 22 Jun '20

22 Jun '20

Hi Eliot, those 3 lines broke the cygwin build... (https://github.com/OpenSmalltalk/opensmalltalk-vm/issues/498) Can we make it msvc-build specific? -- You are receiving this because you are subscribed to this thread. Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/920248dc54ecbcadd9…

1 0

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

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Vm-dev June 2020