VM Maker: VMMaker.oscog-eem.2205.mcz

 
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2205.mcz

==================== Summary ====================

Name: VMMaker.oscog-eem.2205
Author: eem
Time: 27 April 2017, 12:57:00.992119 pm
UUID: c552d4f3-c593-4a3e-9f31-635d61a96c5d
Ancestors: VMMaker.oscog-eem.2204

includesSubString: is deprecated.

=============== Diff against VMMaker.oscog-eem.2204 ===============

Item was changed:
  ----- Method: CCodeGenerator>>emitCConstants:on: (in category 'C code generator') -----
  emitCConstants: constList on: aStream
  "Store the global variable declarations on the given stream."
  constList isEmpty ifTrue: [^self].
  aStream cr; nextPutAll: '/*** Constants ***/'; cr.
  (self sortStrings: constList) do:
  [:varName| | node default value conditional |
  node := constants at: varName.
  node name isEmpty ifFalse:
  ["If the definition includes a C comment, or looks like a conditional, take it as is, otherwise convert
   the value from Smalltalk to C.
   Allow the class to provide an alternative definition, either of just the value or the whole shebang."
  default := (node value isString
+ and: [(node value includesSubstring: '/*')
+ or: [(node value includesSubstring: ' ? ') and: [node value includesSubstring: ' : ']]])
- and: [(node value includesSubString: '/*')
- or: [(node value includesSubString: ' ? ') and: [node value includesSubString: ' : ']]])
  ifTrue: [node value]
  ifFalse: [self cLiteralFor: node value name: varName].
  default = #undefined
  ifTrue: [aStream nextPutAll: '#undef '; nextPutAll: node name; cr]
  ifFalse:
  [conditional := (vmClass ifNil: VMBasicConstants) defineAtCompileTime: node name.
  conditional ifTrue:
  [aStream nextPutAll: '#if !!defined('; nextPutAll: node name; nextPutAll: ') /* Allow this to be overridden on the compiler command line */'; cr].
  value := vmClass
  ifNotNil:
  [(vmClass specialValueForConstant: node name default: default)
  ifNotNil: [:specialDef| specialDef]
  ifNil: [default]]
  ifNil: [default].
  value first ~= $# ifTrue:
  [aStream nextPutAll: (conditional ifTrue: ['# define '] ifFalse: ['#define ']); nextPutAll: node name; space].
  aStream nextPutAll: value; cr.
  conditional ifTrue:
  [aStream nextPutAll: '#endif'; cr]]]].
  aStream cr!

Item was changed:
  ----- Method: CCodeGenerator>>emitCConstantsOn: (in category 'C code generator') -----
  emitCConstantsOn: aStream
  "Store the global variable declarations on the given stream."
  | unused |
  unused := constants keys asSet.
  "Don't generate any defines for the externally defined constants,
  STACKVM, COGVM, COGMTVM et al, unless they're actually used."
  (VMClass class>>#initializeMiscConstants) literalsDo:
  [:lit|
  (lit isVariableBinding and: [lit key isString]) ifTrue:
  [unused add: lit key]].
  methods do:
  [:meth|
  meth declarations keysDo:
  [:v|
  (meth typeFor: v in: self) ifNotNil:
  [:type| unused remove: type ifAbsent: []]].
  unused remove: meth returnType ifAbsent: [].
  meth parseTree nodesDo:
  [:n| n isConstant ifTrue: [unused remove: n name ifAbsent: []]]].
  unused copy do:
  [:const|
+ (variableDeclarations anySatisfy: [:value| value includesSubstring: const]) ifTrue:
- (variableDeclarations anySatisfy: [:value| value includesSubString: const]) ifTrue:
  [unused remove: const ifAbsent: []]].
  "and VMBasicConstants mostBasicConstantNames *must* be taken from interp.h"
  unused addAll: VMBasicConstants mostBasicConstantNames.
  self emitCConstants: (constants keys reject: [:any| unused includes: any]) on: aStream!

Item was changed:
  ----- Method: CCodeGenerator>>emitCMacros:on: (in category 'C code generator') -----
  emitCMacros: methodList on: aStream
  "Store the global variable declarations on the given stream.  Answer any constants used in the macros."
  | usedConstants |
  macros isEmpty ifTrue: [^#()].
  aStream cr; nextPutAll: '/*** Macros ***/'; cr.
  usedConstants := Set new.
  (methodList reject: [:m| m isRealMethod]) do:
  [:m |
  m definedAsMacro ifTrue:
  [aStream
  nextPutAll: '#define ';
  nextPutAll:(self cFunctionNameFor: m selector);
  nextPutAll: (macros at: m selector); cr.
  m compiledMethod literalsDo:
  [:lit|
+ (lit isVariableBinding and: [(macros at: m selector) includesSubstring: lit key]) ifTrue:
- (lit isVariableBinding and: [(macros at: m selector) includesSubString: lit key]) ifTrue:
  [usedConstants add: lit key]]]].
  aStream cr.
  ^usedConstants!

Item was changed:
  ----- Method: CCodeGenerator>>emitGlobalCVariablesOn: (in category 'C code generator') -----
  emitGlobalCVariablesOn: aStream
  "Store the global variable declarations on the given stream."
 
  aStream cr; nextPutAll: '/*** Global Variables ***/'; cr.
 
  (self sortStrings: (variables select: [:v| vmClass mustBeGlobal: v])) do:
  [:var | | varString decl |
  varString := var asString.
  decl := variableDeclarations at: varString ifAbsent: ['sqInt ' , varString].
  decl first == $# "support cgen var: #bytecodeSetSelector declareC: '#define bytecodeSetSelector 0' hack"
  ifTrue:
  [aStream nextPutAll: decl; cr]
  ifFalse:
+ [(decl includesSubstring: ' private ') ifFalse: "work-around hack to prevent localization of variables only referenced once."
- [(decl includesSubString: ' private ') ifFalse: "work-around hack to prevent localization of variables only referenced once."
  [(decl beginsWith: 'static') ifFalse: [aStream nextPutAll: 'VM_EXPORT '].
  (decl includes: $=) ifTrue:
  [decl := decl copyFrom: 1 to: (decl indexOf: $=) - 1].
  aStream
  nextPutAll: decl;
  nextPut: $;;
  cr]]].
  aStream cr!

Item was changed:
  ----- Method: CCodeGenerator>>selectAPIVariables (in category 'accessing') -----
  selectAPIVariables
+ ^variableDeclarations reject: [:decl| decl includesSubstring: 'static ']!
- ^variableDeclarations reject: [:decl| decl includesSubString: 'static ']!

Item was changed:
  ----- Method: CCodeGenerator>>var:declareC: (in category 'public') -----
  var: varName declareC: declarationString
  "Record the given C declaration for a global variable."
 
+ (declarationString includesSubstring: varName) ifFalse:
- (declarationString includesSubString: varName) ifFalse:
  [self error: 'declaration omits variable name.  probably an error.  use e.g. var:type:'].
  variableDeclarations at: varName asString put: declarationString.!

Item was changed:
  ----- Method: CCodeGeneratorGlobalStructure>>placeInStructure: (in category 'C code generator') -----
  placeInStructure: var
  "See if we should put this array into a structure.
  The variables listed are hardcoded as C in the interpreter thus they don't get resolved via TVariableNode logic.
  Also let's ignore variables that have special definitions that require initialization, and the function def which has problems."
 
  | check |
  check := variableDeclarations at: var ifAbsent: [''].
  (check includes: $=) ifTrue: [^false].
  (check includes: $() ifTrue: [^false].
+ (check includesSubstring: 'static') ifTrue: [^false].
+ (check includesSubstring: 'volatile') ifTrue: [^false].
- (check includesSubString: 'static') ifTrue: [^false].
- (check includesSubString: 'volatile') ifTrue: [^false].
 
  ^(vmClass mustBeGlobal: var) not!

Item was changed:
  ----- Method: StackInterpreter class>>reorganizeAsISeeFit (in category 'miscellaneous') -----
  reorganizeAsISeeFit
  "StackInterpreter reorganizeAsISeeFit"
  "CoInterpreter reorganizeAsISeeFit"
  | initializations bytecodes privates remainder |
  initializations := OrderedCollection new.
  bytecodes := OrderedCollection new.
  privates := OrderedCollection new.
  remainder := OrderedCollection new.
  self organization categories do:
  [:cat|
+ ((cat includesSubstring: 'initializ')
- ((cat includesSubString: 'initializ')
  ifTrue: [initializations]
  ifFalse:
+ [((cat endsWith: 'bytecodes') or: [cat includesSubstring: 'selector sends'])
- [((cat endsWith: 'bytecodes') or: [cat includesSubString: 'selector sends'])
  ifTrue: [bytecodes]
  ifFalse:
+ [(cat includesSubstring: 'private')
- [(cat includesSubString: 'private')
  ifTrue: [privates]
  ifFalse: [remainder]]])
  add: cat].
  self organization categories: initializations sort, bytecodes sort, remainder sort, privates sort!

Item was changed:
  ----- Method: TMethod>>argConversionExprFor:stackIndex: (in category 'primitive compilation') -----
  argConversionExprFor: varName stackIndex: stackIndex
  "Return the parse tree for an expression that fetches and converts the
  primitive argument at the given stack offset."
  | exprList decl type stmtList |
  exprList := OrderedCollection new.
  ((decl := declarations at: varName ifAbsent: []) notNil
  and: ['int' ~= (type := (decl copyReplaceAll: varName with: '') withBlanksTrimmed)])
  ifTrue:
  [(decl includes: $*) ifTrue: "array"
+ [(decl includesSubstring: 'char')
- [(decl includesSubString: 'char')
  ifTrue:
  [| expr |
  expr := '(interpreterProxy isBytes: (interpreterProxy stackValue: (stackIndex))) ifFalse: [^interpreterProxy primitiveFail]'.
  expr := expr copyReplaceAll: 'interpreterProxy' with: self vmNameString.
  expr := expr copyReplaceAll: 'stackIndex' with: stackIndex printString.
  exprList addLast: expr].
  exprList addLast: varName , ' := ', self vmNameString, ' arrayValueOf: (', self vmNameString, ' stackValue: (' , stackIndex printString , '))'.
  exprList addLast: varName , ' := ' , varName , ' - 1'] "so that varName[1] is the zero'th element"
  ifFalse: "must be a double"
  [type ~= 'double' ifTrue:
  [self error: 'unsupported type declaration in a translated primitive method'].
  exprList addLast: varName , ' := ', self vmNameString, ' stackFloatValue: ' , stackIndex printString]]
  ifFalse: "undeclared variables are taken to be integer"
  [exprList addLast: varName , ' := ', self vmNameString, ' stackIntegerValue: ' , stackIndex printString].
  stmtList := OrderedCollection new.
  exprList do: [:e | stmtList addAll: (self statementsFor: e varName: varName)].
  ^ stmtList!

Item was changed:
  ----- Method: TMethod>>emitCFunctionPrototype:generator:isPrototype: (in category 'C code generation') -----
  emitCFunctionPrototype: aStream generator: aCodeGen isPrototype: isPrototype "<Boolean>"
  "Emit a C function header for this method onto the given stream.
  Answer if the method has any compileTimeOptionPragmas"
  | compileTimeOptionPragmas returnTypeIsFunctionPointer |
  (compileTimeOptionPragmas := self compileTimeOptionPragmas) notEmpty ifTrue:
  [self outputConditionalDefineFor: compileTimeOptionPragmas on: aStream].
  returnTypeIsFunctionPointer := returnType notNil
  and: [returnType last = $)
+ and: [returnType includesSubstring: (aCodeGen cFunctionNameFor: selector)]].
- and: [returnType includesSubString: (aCodeGen cFunctionNameFor: selector)]].
  export
  ifTrue:
  [aStream nextPutAll: 'EXPORT('; nextPutAll: returnType; nextPut: $)]
  ifFalse:
  [self isStatic
  ifTrue: [aStream nextPutAll: 'static ']
  ifFalse:
  [isPrototype ifTrue:
  [aStream nextPutAll: 'extern ']].
  (isPrototype or: [inline ~~ #always]) ifFalse: [aStream nextPutAll: 'inline '].
  aStream nextPutAll: (returnType ifNil: [#sqInt])].
  (functionAttributes isNil or: [returnTypeIsFunctionPointer]) ifFalse:
  [aStream space; nextPutAll: functionAttributes].
  isPrototype ifTrue: [aStream space] ifFalse: [aStream cr].
  returnTypeIsFunctionPointer ifFalse:
  [aStream
  nextPutAll: (aCodeGen cFunctionNameFor: selector);
  nextPut: $(.
  args isEmpty
  ifTrue: [aStream nextPutAll: #void]
  ifFalse:
  [args
  do: [:arg| aStream nextPutAll: (self declarationAt: arg)]
  separatedBy: [aStream nextPutAll: ', ']].
  aStream nextPut: $)].
  isPrototype ifTrue:
  [aStream nextPut: $;; cr.
  compileTimeOptionPragmas isEmpty ifFalse:
  [aCodeGen maybeEmitPrimitiveFailureDefineFor: selector on: aStream.
  self terminateConditionalDefineFor: compileTimeOptionPragmas on: aStream]].
  ^compileTimeOptionPragmas notEmpty!

Item was changed:
  ----- Method: TMethod>>removeUnusedTempsIn: (in category 'utilities') -----
  removeUnusedTempsIn: aCodeGen
  "Remove all of the unused temps in this method. Answer a set of the references."
  "After inlining some variable references are now obsolete, we could fix them there
  but the code seems a bit complicated, the other choice to to rebuild the locals
  before extruding. This is done here"
  | usedVariables |
  usedVariables := self allReferencedVariablesUsing: aCodeGen.
  "reset the locals to be only those still referred to"
  locals do:
  [:local|
  ((usedVariables includes: local) not
+  and: [((declarations at: local ifAbsent: ['']) includesSubstring: 'static') not
+  and: [((declarations at: local ifAbsent: ['']) includesSubstring: 'extern') not]]) ifTrue:
-  and: [((declarations at: local ifAbsent: ['']) includesSubString: 'static') not
-  and: [((declarations at: local ifAbsent: ['']) includesSubString: 'extern') not]]) ifTrue:
  [locals remove: local.
  declarations removeKey: local ifAbsent: []]].
  ^usedVariables!

Item was changed:
  ----- Method: VMClass class>>initialize (in category 'initialization') -----
  initialize
  (Utilities classPool at: #CommonRequestStrings ifAbsent: []) ifNotNil:
  [:commonRequestStringHolder|
+ (commonRequestStringHolder contents asString includesSubstring: 'VMClass open') ifFalse:
- (commonRequestStringHolder contents asString includesSubString: 'VMClass open') ifFalse:
  [Utilities appendToCommonRequests: '-\VMMaker generateConfiguration\VMMaker generateAllConfigurationsUnderVersionControl\VMMaker generateAllSpurConfigurations\VMClass openCogMultiWindowBrowser\VMClass openObjectMemoriesInterpretersBrowser\VMClass openSpurMultiWindowBrowser\VMClass openCogSpurMultiWindowBrowser' withCRs]].
  ExpensiveAsserts := false!

Item was changed:
  ----- Method: VMMaker>>generateExportsFile (in category 'exports') -----
  generateExportsFile
  "Store the exports on the given file"
  | cg contents filePath fileStream |
  filePath := self interpreterExportsFilePath.
  "don't bother endlessly regenerating the example file."
  (internalPlugins isEmpty
+ and: [(filePath includesSubstring: 'example')
- and: [(filePath includesSubString: 'example')
  and: [FileDirectory default fileExists: filePath]]) ifTrue:
  [^self].
  cg := self createCodeGenerator.
  cg vmClass: self interpreterClass.
  contents := String streamContents:
  [:s|
  s
  nextPutAll:'/* This is an automatically generated table of all builtin modules in the VM';
  cr;
  next: 3 put: Character space;
  nextPutAll: (cg shortMonticelloDescriptionForClass: cg vmClass);
  cr;
  nextPutAll:' */';
  cr.
  s cr; nextPutAll:'extern sqExport vm_exports[];'.
  s cr; nextPutAll: 'extern sqExport os_exports[];'.
  self internalPluginsDo:[:cls|
  s cr; nextPutAll: 'extern sqExport '; nextPutAll: cls moduleName; nextPutAll:'_exports[];'.
  ].
  s cr.
 
  s cr; nextPutAll:'sqExport *pluginExports[] = {'.
  s crtab; nextPutAll:'vm_exports,'.
  s crtab; nextPutAll: 'os_exports,'.
  self internalPluginsDo:[:cls|
  s crtab; nextPutAll: cls moduleName; nextPutAll:'_exports,'
  ].
  s crtab; nextPutAll:'NULL'.
  s cr; nextPutAll:'};'; cr].
  (cg needToGenerateHeader: (FileDirectory baseNameFor: filePath) file: filePath contents: contents) ifTrue:
  [[fileStream := VMMaker forceNewFileNamed: filePath]
  on: FileDoesNotExistException
  do:[^self couldNotOpenFile: filePath].
  fileStream nextPutAll: contents; close]!

Item was changed:
  ----- Method: VMStructType class>>needsTypeTag (in category 'translation') -----
  needsTypeTag
  self instVarNamesAndTypesForTranslationDo:
  [:ivn :type|
  ((type isArray ifTrue: [type] ifFalse: [{type}]) anySatisfy:
  [:str|
  str isString
+ and: [str includesSubstring: self structTagName]]) ifTrue:
- and: [str includesSubString: self structTagName]]) ifTrue:
  [^true]].
  ^false
 
  "VMStructType allSubclasses select: [:sc| sc needsTypeTag]"!