[Vm-dev] VM Maker: VMMaker.oscog-eem.833.mcz

Clément Bera bera.clement at gmail.com
Thu Jul 24 09:50:05 UTC 2014


2014-07-24 11:35 GMT+02:00 <commits at source.squeak.org>:

>
> Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
> http://source.squeak.org/VMMaker/VMMaker.oscog-eem.833.mcz
>
> ==================== Summary ====================
>
> Name: VMMaker.oscog-eem.833
> Author: eem
> Time: 23 July 2014, 11:34:44.69 pm
> UUID: ca999c15-a8a5-449e-82b8-8b9d683b3e1b
> Ancestors: VMMaker.oscog-eem.832
>
> Start adding the SistaV1 bytecode set to the Sista VMs.
>

Yeeeessss !!!!! I can't wait to see that.

Btw, are you really committing this version at 3am ?

>
> Make Slang provide a comprehensible error message when
> certain bytecodes are as-yet-unimplemented instead of
> crashing horribly deep in interpreter dispatch inlining.
>
> Nuke a couple of the obsolete VMMaker subclasses.
>
> =============== Diff against VMMaker.oscog-eem.832 ===============
>
> Item was added:
> + ----- Method: CCodeGenerator>>abortBlock (in category 'accessing') -----
> + abortBlock
> +       ^vmMaker ifNotNil: [:vmm| vmm abortBlock]!
>
> Item was added:
> + ----- Method: Cogit
> class>>initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid (in
> category 'class initialization') -----
> + initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid
> +       "SimpleStackBasedCogit
> initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid"
> +       "StackToRegisterMappingCogit
> initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid"
> +
> +       | v3Table v1Table |
> +       "N.B. Must do it backwards to evaluate
> AltBlockCreationBytecodeSize & BlockCreationBytecodeSize correctly."
> +       self initializeBytecodeTableForSistaV1.
> +       v1Table := generatorTable.
> +       AltBlockCreationBytecodeSize := BlockCreationBytecodeSize.
> +       self initializeBytecodeTableForSqueakV3PlusClosures.
> +       v3Table := generatorTable.
> +       generatorTable := CArrayAccessor on: v3Table object, v1Table
> object!
>
> Item was removed:
> - MacOSPowerPCOS9VMMaker subclass: #MacOSPowerPCOS9BrowserVMMaker
> -       instanceVariableNames: ''
> -       classVariableNames: ''
> -       poolDictionaries: ''
> -       category: 'VMMaker-Building'!
> -
> - !MacOSPowerPCOS9BrowserVMMaker commentStamp: 'tpr 5/5/2003 12:26' prior:
> 0!
> - A Special subclass of VMMaker for building MAc OS-9 browser-plugin vms!
>
> Item was removed:
> - ----- Method: MacOSPowerPCOS9BrowserVMMaker
> class>>isActiveVMMakerClassFor: (in category 'initialisation') -----
> - isActiveVMMakerClassFor: platformName
> -       ^false!
>
> Item was removed:
> - ----- Method: MacOSPowerPCOS9BrowserVMMaker>>initialize (in category
> 'initialize') -----
> - initialize
> -       super initialize.
> -       forBrowser := true!
>
> Item was removed:
> - VMMaker subclass: #MacOSPowerPCOS9VMMaker
> -       instanceVariableNames: ''
> -       classVariableNames: ''
> -       poolDictionaries: ''
> -       category: 'VMMaker-Building'!
> -
> - !MacOSPowerPCOS9VMMaker commentStamp: 'tpr 5/5/2003 12:27' prior: 0!
> - A VMMaker subclass to suit Mac OS!
>
> Item was removed:
> - ----- Method: MacOSPowerPCOS9VMMaker class>>isActiveVMMakerClassFor: (in
> category 'initialisation') -----
> - isActiveVMMakerClassFor: platformName
> -       "Does this class claim to be that properly active subclass of
> VMMaker for this platform?"
> -
> -       ^platformName = 'Mac OS'" and: [Smalltalk platformSubtype =
> 'PowerPC'] <- this used to be used but prevents any attempt to do the
> crossplatform generation thang. How can we handle that bit properly?"!
>
> Item was removed:
> - ----- Method: MacOSPowerPCOS9VMMaker>>createCodeGenerator (in category
> 'initialize') -----
> - createCodeGenerator
> -       "Set up a CCodeGenerator for this VMMaker - Mac OS uses the global
> struct and local def of the
> -        structure.  The global struct/loca def regime appears to be about
> 10% faster than the default
> -        regime for Smalltalk-intensive macro benchmarks for both the
> Intel and gcc 4.0 compiler on x86.
> -        eem 12/10/2008 14:34 2.16 GHz Intel Core Duo MacBook Pro Mac OS X
> 10.4.11"
> -       ^CCodeGeneratorGlobalStructure new
> -               vmMaker: self;
> -               structDefDefine: '1';
> -               "structDefDefine: 'defined(PPC) || defined(_POWER) ||
> defined(__powerpc__) || defined(__ppc__)';"
> -               logger: logger;
> -               yourself!
>
> Item was changed:
>   ----- Method: RiscOSVMMaker>>createCodeGenerator (in category
> 'initialize') -----
>   createCodeGenerator
>   "set up a CCodeGenerator for this VMMaker - RiscOS uses the global
> struct and no local def of the structure because of the global register
> trickery"
>         ^CCodeGeneratorGlobalStructure new
>                 vmMaker: self;
>                 logger: logger;
> +               options: optionsDictionary;
>                 yourself!
>
> Item was changed:
>   ----- Method: StackInterpreter class>>initializeBytecodeTable (in
> category 'initialization') -----
>   initializeBytecodeTable
>         "StackInterpreter initializeBytecodeTable"
>
> +       (initializationOptions at: #bytecodeTableInitializer ifAbsent:
> nil) ifNotNil:
> +               [:initalizer| ^self perform: initalizer].
> +
>         NewspeakVM ifTrue:
>                 [^MULTIPLEBYTECODESETS
>                         ifTrue: [self
> initializeBytecodeTableForNewspeakV3PlusClosuresNewspeakV4Hybrid]
>                         ifFalse: [self
> initializeBytecodeTableForNewspeakV3PlusClosures]].
>
>         ^self initializeBytecodeTableForSqueakV3PlusClosures!
>
> Item was added:
> + ----- Method: StackInterpreter
> class>>initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid (in
> category 'initialization') -----
> + initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid
> +       "StackInterpreter
> initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid"
> +
> +       | v3Table v1Table |
> +       self initializeBytecodeTableForSistaV1.
> +       v1Table := BytecodeTable.
> +       AltBytecodeEncoderClassName := BytecodeEncoderClassName.
> +       AltLongStoreBytecode := LongStoreBytecode.
> +       self initializeBytecodeTableForSqueakV3PlusClosures.
> +       v3Table := BytecodeTable.
> +       BytecodeTable := v3Table, v1Table!
>
> Item was added:
> + ----- Method: StackToRegisterMappingCogit
> class>>initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid (in
> category 'class initialization') -----
> + initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid
> +       "StackToRegisterMappingCogit
> initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid"
> +
> +       super initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid.
> +       isPushNilFunction := #squeakV3orSistaV1:Is:Push:Nil:.
> +       pushNilSizeFunction := #squeakV3orSistaV1PushNilSize:!
>
> Item was removed:
> - ----- Method: TMethod>>buildCaseStmt: (in category 'transformations')
> -----
> - buildCaseStmt: aSendNode
> -       "Build a case statement node for the given send of dispatchOn:in:."
> -       "Note: the first argument is the variable to be dispatched on. The
> second argument is a constant node holding an array of unary selectors,
> which will be turned into sends to self."
> -
> -       ((aSendNode args size >= 2) and:
> -        [aSendNode args second isConstant and:
> -        [aSendNode args second value class = Array]]) ifFalse: [
> -               self error: 'wrong node structure for a case statement'.
> -       ].
> -
> -       ^TCaseStmtNode new
> -               setExpression: aSendNode args first
> -               selectors: aSendNode args second value
> -               arguments: (aSendNode args copyFrom: 3 to: aSendNode args
> size)!
>
> Item was added:
> + ----- Method: TMethod>>buildCaseStmt:in: (in category 'transformations')
> -----
> + buildCaseStmt: aSendNode in: aCodeGen
> +       "Build a case statement node for the given send of dispatchOn:in:."
> +       "Note: the first argument is the variable to be dispatched on. The
> second argument is a constant node holding an array of unary selectors,
> which will be turned into sends to self."
> +
> +       | unimplemented errorMessage |
> +       ((aSendNode args size >= 2) and:
> +        [aSendNode args second isConstant and:
> +        [aSendNode args second value class = Array]]) ifFalse:
> +               [self error: 'wrong node structure for a case statement'].
> +
> +       unimplemented := aSendNode args second value reject: [:s| self
> definingClass includesSelector: s].
> +       unimplemented isEmpty ifFalse:
> +               [errorMessage := 'The following selectors are
> unimplemented: ',
> +                                                       (String
> streamContents: [:s| unimplemented do: [:sel| s crtab; store: sel]]).
> +                (self confirm: errorMessage
> +                       orCancel: aCodeGen abortBlock) ifFalse:
> +                               [self halt]].
> +
> +       ^TCaseStmtNode new
> +               setExpression: aSendNode args first
> +               selectors: aSendNode args second value
> +               arguments: (aSendNode args copyFrom: 3 to: aSendNode args
> size)!
>
> Item was changed:
>   ----- Method: TMethod>>prepareMethodIn: (in category 'transformations')
> -----
>   prepareMethodIn: aCodeGen
>         "Record sends of builtin operators, map sends of the special
> selector dispatchOn:in:
>          with case statement nodes, and map sends of caseOf:[otherwise:]
> to switch statements.
>          As a hack also update the types of variables introduced to
> implement cascades correctly.
>          This has to be done at the same time as this is done, so why not
> piggy back here?"
>         extraVariableNumber ifNotNil:
>                 [declarations keysAndValuesDo:
>                         [:varName :decl|
>                         decl isBlock ifTrue:
>                                 [self assert: ((varName beginsWith:
> 'cascade') and: [varName last isDigit]).
>                                  locals add: varName.
>                                  self declarationAt: varName
>                                         put: (decl value: self value:
> aCodeGen), ' ', varName]]].
>         aCodeGen
>                 pushScope: declarations
>                 while:"N.B.  nodesWithParentsDo: is bottom-up, hence
> replacement is destructive and conserved."
>                         [parseTree nodesWithParentsDo:
>                                 [:node :parent|
>                                  node isSend ifTrue:
>                                         [(aCodeGen isBuiltinSelector: node
> selector)
>                                                 ifTrue:
>                                                         [node
> isBuiltinOperator: true.
>                                                         "If a to:by:do:'s
> limit has side-effects, declare the limit variable, otherwise delete it
> from the args"
>                                                          (node selector =
> #to:by:do:
>                                                           and: [node args
> size = 4]) ifTrue:
>                                                                 [|
> limitExpr |
>                                                                  limitExpr
> := node args first.
>
>  (limitExpr anySatisfy:
>
>       [:subNode|
>
>       subNode isSend
>
>       and: [(aCodeGen isBuiltinSelector: subNode selector) not
>
>       and: [(subNode isStructSendIn: aCodeGen) not]]])
>
> ifTrue: [locals add: node args last name]
>
> ifFalse:
>
>       [node arguments: node args allButLast]]]
>                                                 ifFalse:
>                                                         [(CaseStatements
> includes: node selector) ifTrue:
> +                                                               [parent
> replaceNodesIn: (Dictionary newFromPairs: { node. self buildCaseStmt: node
> in: aCodeGen})].
> -                                                               [parent
> replaceNodesIn: (Dictionary newFromPairs: { node. self buildCaseStmt:
> node})].
>                                                          (#(caseOf:
> #caseOf:otherwise:) includes: node selector) ifTrue:
>                                                                 [parent
> replaceNodesIn: (Dictionary newFromPairs: { node. self buildSwitchStmt:
> node parent: parent })]]]]]!
>
> Item was changed:
>   ----- Method: UnixVMMaker>>createCodeGenerator (in category
> 'initialisation') -----
>   createCodeGenerator
>
>         ^CCodeGeneratorGlobalStructure new
>                 vmMaker: self;
>                 logger: logger;
> +               options: optionsDictionary;
>                 yourself!
>
> Item was changed:
>   Object subclass: #VMMaker
> +       instanceVariableNames: 'inline forBrowser allPlugins
> internalPlugins externalPlugins platformName sourceDirName
> platformRootDirName logger interpreterClassName cogitClassName is64BitVM
> optionsDictionary abortBlock'
> -       instanceVariableNames: 'inline forBrowser allPlugins
> internalPlugins externalPlugins platformName sourceDirName
> platformRootDirName logger interpreterClassName cogitClassName is64BitVM
> optionsDictionary'
>         classVariableNames: 'DirNames'
>         poolDictionaries: ''
>         category: 'VMMaker-Building'!
>
>   !VMMaker commentStamp: 'tpr 5/5/2003 12:28' prior: 0!
>   This class builds a VM codebase from the in-image and on-file code.
>
>   The platforms file tree you need can be downloaded via cvs from
> http://squeak.Sourceforge.net. See also the swiki (
> http://minnow.cc.gatech.edu/squeak/2106) for instructions.
>
>   It is fairly configurable as to where directories live and can handle
> multiple platform's source trees at once. It's main purpose is to allow
> easy building of source trees with any combination of
> internal/external/unused plugins to suit your platform needs and
> capabilities. For example, the Acorn has no need of Sound or AsynchFile
> plugins since I haven't written any platform code for them.
>
>   There is a simple UI tool for this
>         VMMakerTool openInWorld
>   will open a reasonably self explanatory tool with balloon help to
> explain all the fields - and a help window on top of that.
>
>   There are some simple workspace & inspector commands, allowing scripted
> building:
>         VMMaker default initializeAllExternal generateEntire
>   for example will build sources for a system with all the plugins
> external whereas
>         VMMaker default initializeAllInternal generateEntire
>   would build all applicable plugins for internal compilation.
>         (VMMaker forPlatform: 'Mac OS') initializeAllExternal
> generateEntire
>   would build a source tree for a Mac even on a Windows machine (err,
> ignoring for now the irritation of lineends).
>
>         If you have a slightly more complex configuration you want to use,
> perhaps with Socket and Serial support external (because for your case they
> are rarely used and saving the space has some value) then you could try
>                 (VMMaker default initializeAllInternalBut: #(SocketPlugin
> SerialPlugin) generateEntire
>         More complex still would be
>                 (VMMaker default initializeInternal: #(BitBltPlugin
> MiscPrimsPlugin FilePlugin) external: #(SocketPlugin ZipPlugin B2DPlugin)
>   which allows you to precisely list all the plugins to use.
>
>   WARNING If you miss out a plugin you need, it won't be there. This
> message is really best suited to use by a UI like VMMakerTool.
>
>         To save a configuration for later use, you need to send
> #saveConfiguration to an active instance of VMMaker. Obviously you could
> simply use
>                 (VMMaker default initializeAllInternalBut: #(SocketPlugin
> SerialPlugin) saveConfiguration
>   but inspecting
>                 VMMaker default
>   and altering the internalPlugins and externalPlugins or the boolean
> flags for inline or forBrowser followed by saving the configuration allows
> ultimate power for now. To load a saved configuration file, use
> #loadConfigurationFrom: aFilename whilst inspecting a VMMaker. The loaded
> state will completely override any pre-existing state, so take care.
>         You can generate only parts of the source tree if you wish; as
> shown above #generateEntire will create the whole collection of internal
> and external plugins as well as the core VM. To create only  the external
> plugins use #generateExternalPlugins, or create a single  plugin with
> #generateExternalPlugin: name. To assemble the main VM including the
> internal plugins, use #generateMainVM. The interpreter 'interp.c' file is
> made with #generateInterpreterFile. You can generate a single internal
> plugin with #generateInternalPlugin: only if it has already been generated
> before; this interlocking is intended to make sure the named primitive
> table in the vm is correct.
>
>   There are some rules to observe in order to use this:-
>   - under the working directory (by default - you can configure it) you
> need a directory called 'platforms' (also configurable) with subdirectories
> named as the platform names returned by Smalltalk platformName (ie unix,
> RiscOS, Mac OS, etc - this isn't configurable). At the very least you need
> the one for your own platform and the pseudo-platform called 'Cross'. By
> adding a 'DirNames' entry for #machineType you can cross 'compile' for some
> other platform. Now all we need is a cross-compiler for the C code :-)
>   - under this directory you must have a simple structure of directories
> for each generated plugin that you support on the platform, plus 'vm'. In
> each directory you place any/all platform specific files (and
> subdirectories) for that plugin. In 'misc' you can place any miscellaneous
> files such as makefiles, resources etc. For example, for unix you have
>         platforms/
>                 unix/
>                         plugins/
>                                 AsynchFilePlugin /
>                                         sqUnixAsynchfile.c
>                         vm/
>                                 sqGnu.h
>                                 Profile/
>                         misc/
>                                 makefile.in
>                                 util/
>
>                                 ...etc
>   Any plugins requiring platform files that you don't support shouldn't
> appear in the resulting code tree. If you try to include an unsupported
> plugin in the list to be made external, the VMMaker simply ignores it.
> However, if you include it in the list to be made internal you will get an
> error since that seems like a potentially serious source of confusion.
>
>   There are three lists of plugins maintained herein:-
>   1) the list of all known generatable plugins. We scan this list and
> compare with the supported plugins as indicated by the file tree.
>   2) the list of chosen internal plugins.
>   3) the list of chosen external plugins.
>   See initializeAllPlugins, initialiseAllExternal etc for fairly obvious
> usage.
>   There is also a short list of directory names in the class variable
> 'DirNames' that you can alter if needed.
>
>   Known problems:-
>   a) since Squeak has really poor filename handling, you can't simply
> change the directory names to '/foo/bar/myEvilCodeBase' and expect it to
> work. You fix file names and I'll fix VMMaker :-)
>   b) Squeak copying of a file loses the assorted permissions, filetype
> info and other useful bits. To workaround this problem, see the
> FileCopyPlugin, which provides the platform independent part of a simple
> access for the OS filecopy capability. So far there are functional plugins
> for unix, Mac and Acorn. DOS machines appear not to need one. This is less
> of a problem in practise now that unix, Acorn & Mac no longer copy files
> from /platforms to /src.
>
>   inline <Boolean> - is the generated code to be inlined or not
>   forBrowser <Boolean> - is this to be a build for in-Browser use? Only
> relevent to Macs
>   allPlugins <Collection> - all the known possible plugins
>   internalPlugins <Collection> - the plugins chosen to be generated for
> internal linking
>   externalPlugins <Collection> - the plugins intended to be external
> plugins
>   exportList <Collection> - a list of function names exported from plugins
> intended to be internal
>   platformName <String> - the name of the platform for which we are
> building a source tree. It is possible to do 'cross-compiles'
>   sourceDirName, platformRootDirName <String> - the name of the directory
> into which we write the generated sources and the name of the directory
> where we should find the platforms tree.!
>
> Item was changed:
>   ----- Method: VMMaker class>>generateSqueakCogSistaVM (in category
> 'configurations') -----
>   generateSqueakCogSistaVM
>         "No primitives since we can use those for the Cog VM"
>         ^VMMaker
>                 generate: CoInterpreter
>                 and: SistaStackToRegisterMappingCogit
> +               with: #(        MULTIPLEBYTECODESETS true
> +                               bytecodeTableInitializer
> initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid)
>                 to: (FileDirectory default pathFromURI: self sourceTree,
> '/sistasrc')
>                 platformDir: (FileDirectory default pathFromURI: self
> sourceTree, '/platforms')
>                 including: #()!
>
> Item was changed:
>   ----- Method: VMMaker class>>generateSqueakSpurCogSistaVM (in category
> 'configurations') -----
>   generateSqueakSpurCogSistaVM
>         "No primitives since we can use those for the Cog VM"
>         ^VMMaker
>                 generate: CoInterpreter
>                 and: SistaStackToRegisterMappingCogit
> +               with: #(        ObjectMemory Spur32BitCoMemoryManager
> +                               MULTIPLEBYTECODESETS true
> +                               bytecodeTableInitializer
> initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid)
> -               with: #(ObjectMemory Spur32BitCoMemoryManager)
>                 to: (FileDirectory default pathFromURI: self sourceTree,
> '/spursistasrc')
>                 platformDir: (FileDirectory default pathFromURI: self
> sourceTree, '/platforms')
>                 including:#()!
>
> Item was added:
> + ----- Method: VMMaker>>abortBlock (in category 'accessing') -----
> + abortBlock
> +       ^abortBlock!
>
> Item was changed:
>   ----- Method: VMMaker>>generateEntire (in category 'generate sources')
> -----
>   generateEntire
>         "Generate the interp, internal plugins and exports as well as the
> external plugins.
>          If this comes from a generator, log it for convenience."
> +       abortBlock := [^self].
>         self configurationGeneratorNameOrNil ifNotNil:
>                 [:generator|
>                  logger cr; nextPutAll: (generator selector
> copyReplaceAll: 'generate' with: '').
>                  interpreterClassName ifNotNil:
>                         [logger space; nextPutAll: (CCodeGenerator
> shortMonticelloDescriptionForClass: (Smalltalk classNamed:
> interpreterClassName))].
>                  logger cr; flush].
>         self generateMainVM.
>         self generateExternalPlugins!
>
> Item was changed:
>   ----- Method: Win32VMMaker>>createCodeGenerator (in category
> 'initialize') -----
>   createCodeGenerator
>         "Set up a CCodeGenerator for this VMMaker - On Windows we use the
> gcc 2.95.x compiler
>          which does better without the global struct."
>         ^CCodeGeneratorGlobalStructure new
>                 vmMaker: self;
>                 structDefDefine: '0';
>                 "structDefDefine: 'defined(PPC) || defined(_POWER) ||
> defined(__powerpc__) || defined(__ppc__)';"
>                 logger: logger;
> +               options: optionsDictionary;
>                 yourself!
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://lists.squeakfoundation.org/pipermail/vm-dev/attachments/20140724/9b5f598b/attachment-0001.htm


More information about the Vm-dev mailing list