VM Maker: VMMaker-dtl.412.mcz

 
David T. Lewis uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker-dtl.412.mcz

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

Name: VMMaker-dtl.412
Author: dtl
Time: 1 March 2020, 11:10:22.475 am
UUID: ba78d0f8-9d53-4f41-a3de-4c2fd63d0318
Ancestors: VMMaker-dtl.411

VMMaker 4.18.1
Compatibility for oscog versions of the C preprocessor directives. Map oscog versions to the original implementations by fudging the argument lists in code generation. Add unit tests to ensure correct generation of directives and conditionals. Allows oscog branch methods to be loaded and generated without modification.

=============== Diff against VMMaker-dtl.411 ===============

Item was added:
+ ----- Method: CCodeGenerator>>generateOscogInlineCppDirective:on:indent: (in category 'C translation') -----
+ generateOscogInlineCppDirective: msgNode on: aStream indent: level
+ "Generate the C code for this message onto the given stream."
+
+ aStream cr; nextPutAll: msgNode args first value.!

Item was added:
+ ----- Method: CCodeGenerator>>generateOscogInlineCppIf:on:indent: (in category 'C translation') -----
+ generateOscogInlineCppIf: msgNode on: aStream indent: level
+ "Generate the C code for this message onto the given stream."
+
+ "Translate cppIf:ifTrue: as if it was isDefined:inSmalltalk:comment:ifTrue:
+ by adding nil argument entries for the comment node and the Smalltalk
+ expression node. Compatibility for externally maintained plugins."
+ msgNode args size = 2
+ ifTrue: [| newArgs |
+ "Expand the arguments array to match that of cppIf:ifTrue:ifFalse: "
+ newArgs := Array new: 4.
+ newArgs at: 1 put: (msgNode args at: 1).
+ newArgs at: 4 put: (msgNode args at: 2).
+ msgNode
+ setSelector: msgNode selector
+ receiver: msgNode receiver
+ arguments: newArgs].
+ self
+ generateInlineCppIfDef: msgNode
+ on: aStream
+ indent: level
+ !

Item was added:
+ ----- Method: CCodeGenerator>>generateOscogInlineCppIfElse:on:indent: (in category 'C translation') -----
+ generateOscogInlineCppIfElse: msgNode on: aStream indent: level
+ "Generate the C code for this message onto the given stream."
+
+ "Translate cppIf:ifTrue:ifFalse: as if it was isDefined:inSmalltalk:comment:ifTrue:ifFalse:
+ by adding nil argument entries for the comment node and the Smalltalk
+ expression node. Compatibility for externally maintained plugins."
+ msgNode args size = 3
+ ifTrue: [| newArgs |
+ "Expand the arguments array to match that of cppIf:ifTrue:ifFalse: "
+ newArgs := Array new: 5.
+ newArgs at: 1 put: (msgNode args at: 1).
+ newArgs at: 4 put: (msgNode args at: 2).
+ newArgs at: 5 put: (msgNode args at: 3).
+ msgNode
+ setSelector: msgNode selector
+ receiver: msgNode receiver
+ arguments: newArgs].
+ self
+ generateInlineCppIfDefElse: msgNode
+ on: aStream
+ indent: level
+ !

Item was changed:
  ----- Method: CCodeGenerator>>initializeCTranslationDictionary (in category 'C translation') -----
  initializeCTranslationDictionary
  "Initialize the dictionary mapping message names to actions for C code generation."
 
  | pairs |
  translationDict := Dictionary new: 200.
  pairs := #(
  #& #generateAnd:on:indent:
  #| #generateOr:on:indent:
  #and: #generateSequentialAnd:on:indent:
  #or: #generateSequentialOr:on:indent:
  #not #generateNot:on:indent:
 
  #+ #generatePlus:on:indent:
  #- #generateMinus:on:indent:
  #negated #generateNegated:on:indent:
  #* #generateTimes:on:indent:
  #/ #generateDivide:on:indent:
  #// #generateDivide:on:indent:
  #\\ #generateModulo:on:indent:
  #<< #generateShiftLeft:on:indent:
  #>> #generateShiftRight:on:indent:
  #min: #generateMin:on:indent:
  #max: #generateMax:on:indent:
  #between:and: #generateBetweenAnd:on:indent:
 
  #bitAnd: #generateBitAnd:on:indent:
  #bitOr: #generateBitOr:on:indent:
  #bitXor: #generateBitXor:on:indent:
  #bitShift: #generateBitShift:on:indent:
  #signedBitShift: #generateSignedBitShift:on:indent:
  #bitInvert32 #generateBitInvert32:on:indent:
  #bitClear: #generateBitClear:on:indent:
 
  #< #generateLessThan:on:indent:
  #<= #generateLessThanOrEqual:on:indent:
  #= #generateEqual:on:indent:
  #> #generateGreaterThan:on:indent:
  #>= #generateGreaterThanOrEqual:on:indent:
  #~= #generateNotEqual:on:indent:
  #== #generateEqual:on:indent:
  #~~ #generateNotEqual:on:indent:
  #isNil #generateIsNil:on:indent:
  #notNil #generateNotNil:on:indent:
 
  #whileTrue: #generateWhileTrue:on:indent:
  #whileFalse: #generateWhileFalse:on:indent:
  #whileTrue #generateDoWhileTrue:on:indent:
  #whileFalse #generateDoWhileFalse:on:indent:
  #to:do: #generateToDo:on:indent:
  #to:by:do: #generateToByDo:on:indent:
  #repeat #generateRepeat:on:indent:
 
  #ifTrue: #generateIfTrue:on:indent:
  #ifFalse: #generateIfFalse:on:indent:
  #ifTrue:ifFalse: #generateIfTrueIfFalse:on:indent:
  #ifFalse:ifTrue: #generateIfFalseIfTrue:on:indent:
 
  #at: #generateAt:on:indent:
  #at:put: #generateAtPut:on:indent:
  #basicAt: #generateAt:on:indent:
  #basicAt:put: #generateAtPut:on:indent:
 
  #integerValueOf: #generateIntegerValueOf:on:indent:
  #integerObjectOf: #generateIntegerObjectOf:on:indent:
  #isIntegerObject: #generateIsIntegerObject:on:indent:
  #cCode: #generateInlineCCode:on:indent:
  #cCode:inSmalltalk: #generateInlineCCode:on:indent:
  #cPreprocessorDirective: #generateInlineCPreprocessorDirective:on:indent:
  #preprocessorExpression: #generateInlineCppDirective:on:indent:
  #isDefined:inSmalltalk:comment:ifTrue: #generateInlineCppIfDef:on:indent:
  #isDefined:inSmalltalk:comment:ifTrue:ifFalse: #generateInlineCppIfDefElse:on:indent:
  #isDefinedTrueExpression:inSmalltalk:comment:ifTrue:ifFalse: #generateInlineCppIfElse:on:indent:
+ #cPreprocessorDirective: #generateOscogInlineCppDirective:on:indent: "oscog compatibility"
+ #cppIf:ifTrue:ifFalse: #generateOscogInlineCppIfElse:on:indent: "oscog compatibility"
+ #cppIf:ifTrue: #generateOscogInlineCppIf:on:indent: "oscog compatibility"
  #cCoerce:to: #generateCCoercion:on:indent:
  #cCoerceSimple:to: #generateCCoercion:on:indent:
  #addressOf: #generateAddressOf:on:indent:
  #signedIntFromLong #generateSignedIntFromLong:on:indent:
  #signedIntToLong #generateSignedIntToLong:on:indent:
  #signedIntFromShort #generateSignedIntFromShort:on:indent:
  #signedIntToShort #generateSignedIntToShort:on:indent:
  #preIncrement #generatePreIncrement:on:indent:
  #preDecrement #generatePreDecrement:on:indent:
  #inline: #generateInlineDirective:on:indent:
  #asFloat #generateAsFloat:on:indent:
  #asInteger #generateAsInteger:on:indent:
  #asIntegerPtr #generateAsIntegerPtr:on:indent:
  #asUnsignedInteger #generateAsUnsignedInteger:on:indent:
  #asUnsignedIntegerPtr #generateAsUnsignedIntegerPtr:on:indent:
  #asLong #generateAsLong:on:indent:
  #asUnsignedLong #generateAsUnsignedLong:on:indent:
  #asUnsignedLongLong #generateAsUnsignedLongLong:on:indent:
  #asVoidPointer #generateAsVoidPointer:on:indent:
  #asSymbol #generateAsSymbol:on:indent:
  #flag: #generateFlag:on:indent:
  #anyMask: #generateBitAnd:on:indent:
  #raisedTo: #generateRaisedTo:on:indent:
  #touch: #generateTouch:on:indent:
  #bytesPerWord #generateBytesPerWord:on:indent:
  #baseHeaderSize #generateBaseHeaderSize:on:indent:
 
  #sharedCodeNamed:inCase: #generateSharedCodeDirective:on:indent:
 
  #perform: #generatePerform:on:indent:
  #perform:with: #generatePerform:on:indent:
  #perform:with:with: #generatePerform:on:indent:
  #perform:with:with:with: #generatePerform:on:indent:
  #perform:with:with:with:with: #generatePerform:on:indent:
  #perform:with:with:with:with:with: #generatePerform:on:indent:
 
  #value #generateValue:on:indent:
  #value: #generateValue:on:indent:
  #value:value: #generateValue:on:indent:
 
  #shouldNotImplement #generateSmalltalkMetaError:on:indent:
  #shouldBeImplemented #generateSmalltalkMetaError:on:indent:
  ).
 
  1 to: pairs size by: 2 do: [:i |
  translationDict at: (pairs at: i) put: (pairs at: i + 1)].
 
  pairs := #(
  #ifTrue: #generateIfTrueAsArgument:on:indent:
  #ifFalse: #generateIfFalseAsArgument:on:indent:
  #ifTrue:ifFalse: #generateIfTrueIfFalseAsArgument:on:indent:
  #ifFalse:ifTrue: #generateIfFalseIfTrueAsArgument:on:indent:
  #cCode: #generateInlineCCodeAsArgument:on:indent:
  #cCode:inSmalltalk: #generateInlineCCodeAsArgument:on:indent:
 
  #value #generateValueAsArgument:on:indent:
  #value: #generateValueAsArgument:on:indent:
  #value:value: #generateValueAsArgument:on:indent:
  ).
 
  asArgumentTranslationDict := Dictionary new: 8.
  1 to: pairs size by: 2 do: [:i |
  asArgumentTranslationDict at: (pairs at: i) put: (pairs at: i + 1)].
  !

Item was changed:
  ----- Method: ContextInterpreter>>writeImageFileIO:embedded: (in category 'image save/restore') -----
  writeImageFileIO: imageBytes embedded: embedded
 
  | headerStart headerSize f bytesWritten sCWIfn okToWrite |
  <var: #f type: 'sqImageFile'>
  <var: #headerStart type: 'squeakFileOffsetType '>
  <var: #sCWIfn type: 'void *'>
 
  "If the security plugin can be loaded, use it to check for write permission.
  If not, assume it's ok"
  sCWIfn := self ioLoadFunction: 'secCanWriteImage' From: 'SecurityPlugin'.
  sCWIfn ~= 0 ifTrue:[okToWrite := self cCode: '((sqInt (*)(void))sCWIfn)()'.
  okToWrite ifFalse:[^self primitiveFail]].
 
  "local constants"
  headerStart := 0.  
  headerSize := 16 * objectMemory bytesPerWord.  "header size in bytes; do not change!!"
 
+ "self sqSpaceForImage: imageName OfSize: imageBytes + 100000"
+ (self cCode: 'sqImageFileSpaceToSave(imageName, imageBytes + 100000)')
+ ifFalse: ["file system full"
+ self success: false.
+ ^ nil].
+
  f := self cCode: 'sqImageFileOpen(imageName, "wb")'.
  f = nil ifTrue: [
  "could not open the image file for writing"
  self success: false.
  ^ nil].
 
  headerStart := self cCode: 'sqImageFileStartLocation(f,imageName,headerSize+imageBytes)'.
  self cCode: '/* Note: on Unix systems one could put an exec command here, padded to 512 bytes */'.
  "position file to start of header"
  self sqImageFile: f Seek: headerStart.
 
  self putLong: (self imageFormatVersion) toFile: f.
  self putLong: headerSize toFile: f.
  self putLong: imageBytes toFile: f.
  self putLong: (objectMemory startOfMemory) toFile: f.
  self putLong: objectMemory getSpecialObjectsOop toFile: f.
  self putLong: objectMemory getLastHash toFile: f.
  self putLong: (self ioScreenSize) toFile: f.
  self putLong: fullScreenFlag toFile: f.
  self putLong: extraVMMemory toFile: f.
  1 to: 7 do: [:i | self putLong: 0 toFile: f].  "fill remaining header words with zeros"
  self successful ifFalse: [
  "file write or seek failure"
  self cCode: 'sqImageFileClose(f)'.
  ^ nil].
 
  "position file after the header"
  self sqImageFile: f Seek: headerStart + headerSize.
 
  "write the image data"
  bytesWritten := self
  sqImage: (objectMemory pointerForOop: objectMemory getMemory)
  write: f
  size: (self cCode: 'sizeof(unsigned char)')
  length: imageBytes.
  self success: bytesWritten = imageBytes.
  embedded ifFalse: [self setMacFileTypeForImageFile].
+ self sqImageFileClose: f.
- self cCode: 'sqImageFileClose(f)'.
 
  !

Item was added:
+ ----- Method: SlangTest>>testCPreprocessorDirective (in category 'testing preprocessor directives - oscog compatibility') -----
+ testCPreprocessorDirective
+ "Test cPreprocessorDirective: "
+
+ "(SlangTest selector: #testCPreprocessorDirective) run"
+
+ | stssi cString |
+
+ stssi := SlangTestSupportInterpreter inline: false.
+ cString := stssi asCString: #cPreprocessorDirective.
+ self should: ('*# define FOO bar*' match: cString).
+ self should: ' define FOO bar' = ((cString copyAfter: $#) findTokens: Character cr) first.
+ self should: ((cString findTokens: Character cr) select: [:e | e = '#define FOO bar' ]) size = 0.
+ self should: ((cString findTokens: Character cr) select: [:e | e = '# define FOO bar' ]) size = 1.
+ self should: ((cString findTokens: Character cr) select: [:e | e = '## define FOO bar' ]) size = 0.
+ "verify equivalence to the original trunk version"
+ self should: (cString last:37) = ((stssi asCString: #preprocessorExpression) last:37)
+ !

Item was added:
+ ----- Method: SlangTest>>testCppIfIfTrue (in category 'testing preprocessor directives - oscog compatibility') -----
+ testCppIfIfTrue
+ "Test the oscog variant of isDefined:inSmalltalk:comment:ifTrue:
+ Same as  isDefined:inSmalltalk:comment:ifTrue: but does not support the
+ comment and Smalltalk block."
+
+ "(SlangTest selector: #testCppIfIfTrue) run"
+
+ | stssi cString stringWithoutWhiteSpace lines expected |
+
+ stssi := SlangTestSupportInterpreter inline: false.
+
+ "verify that the default Smalltalk block that is evaluated in simulation"
+ self assert: stssi ifdefElseEndif = #defaultBlockForSimulation.
+
+ "verify generated C string"
+ cString := stssi asCString: #cppIfIfTrue.
+ lines := (cString findTokens: Character cr) select: [:e |
+ {
+ '# ifdef HAVE_FOO' .
+ ' return 1;' .
+ '# else' .
+ ' return 0;' .
+ '# endif  // HAVE_FOO'
+ } includes: e ].
+ self should: lines size = 3.
+ self should: ('*return 1*' match: lines second).
+
+ "check the rest of the method, ignoring whitespace and ignoring the leading method comment"
+ stringWithoutWhiteSpace := cString reject: [:e | e isSeparator].
+ expected := 'sqIntcppIfIfTrue(void){#ifdefHAVE_FOOreturn1;#endif//HAVE_FOOreturnnull;}'.
+ self should: expected = (stringWithoutWhiteSpace last: expected size).
+
+ !

Item was added:
+ ----- Method: SlangTest>>testCppIfIfTrueIfFalse (in category 'testing preprocessor directives - oscog compatibility') -----
+ testCppIfIfTrueIfFalse
+ "Test the oscog variant of isDefined:inSmalltalk:comment:ifTrue:ifFalse:
+ Same as  isDefined:inSmalltalk:comment:ifTrue:ifFalse: but does not support
+ the comment and Smalltalk block."
+
+ "(SlangTest selector: #testCppIfIfTrueIfFalse) run"
+
+ | stssi cString stringWithoutWhiteSpace lines expected |
+
+ stssi := SlangTestSupportInterpreter inline: false.
+
+ "verify that the default Smalltalk block that is evaluated in simulation"
+ self assert: stssi ifdefElseEndif = #defaultBlockForSimulation.
+
+ "verify generated C string"
+ cString := stssi asCString: #cppIfIfTrueIfFalse.
+ lines := (cString findTokens: Character cr) select: [:e |
+ {
+ '# ifdef HAVE_FOO' .
+ ' return 1;' .
+ '# else' .
+ ' return 0;' .
+ '# endif  // HAVE_FOO'
+ } includes: e ].
+ self should: lines size = 5.
+ self should: ('*return 1*' match: lines second).
+ self should: ('*return 0*' match: lines fourth).
+
+ "check the rest of the method, ignoring whitespace and ignoring the leading method comment"
+ stringWithoutWhiteSpace := cString reject: [:e | e isSeparator].
+ expected := 'sqIntcppIfIfTrueIfFalse(void){#ifdefHAVE_FOOreturn1;#elsereturn0;#endif//HAVE_FOOreturnnull;}'.
+ self should: expected = (stringWithoutWhiteSpace last: expected size).
+
+
+
+ !

Item was changed:
  ----- Method: SlangTest>>testPreprocessorExpression (in category 'testing preprocessor directives') -----
  testPreprocessorExpression
  "Test preprocessorExpression: "
 
  "(SlangTest selector: #testPreprocessorExpression) run"
 
  | stssi cString |
  self flag: #FIXME. "See redundant implementation in oscog #cPreprocessorDirective: "
 
  stssi := SlangTestSupportInterpreter inline: false.
  cString := stssi asCString: #preprocessorExpression.
  self should: ('*# define FOO bar*' match: cString).
+ self should: ' define FOO bar' = ((cString copyAfter: $#) findTokens: Character cr) first.
  self should: ((cString findTokens: Character cr) select: [:e | e = '# define FOO bar' ]) size = 1.
  self should: ((cString findTokens: Character cr) select: [:e | e = '## define FOO bar' ]) size = 0.
  !

Item was added:
+ ----- Method: SlangTestSupportInterpreter>>cPreprocessorDirective (in category 'preprocessor directives - oscog compatibility') -----
+ cPreprocessorDirective
+
+ self cPreprocessorDirective: '# define FOO bar'.
+ !

Item was added:
+ ----- Method: SlangTestSupportInterpreter>>cppIfIfTrue (in category 'preprocessor directives - oscog compatibility') -----
+ cppIfIfTrue
+ "Exercise the oscog variant. Same as  isDefined:inSmalltalk:comment:ifTrue:
+ but does not support the comment and Smalltalk block."
+
+ self cppIf: #'HAVE_FOO'
+ ifTrue: [ ^true ].
+ ^nil
+ !

Item was added:
+ ----- Method: SlangTestSupportInterpreter>>cppIfIfTrueIfFalse (in category 'preprocessor directives - oscog compatibility') -----
+ cppIfIfTrueIfFalse
+ "Exercise the oscog variant. Same as  isDefined:inSmalltalk:comment:ifTrue:ifFalse:
+ but does not support the comment and Smalltalk block."
+
+ self cppIf: #'HAVE_FOO'
+ ifTrue: [ ^true ]
+ ifFalse: [ ^false ].
+ ^nil
+ !

Item was added:
+ ----- Method: SlangTestSupportInterpreter>>loopExample: (in category 'type declaration') -----
+ loopExample: array1
+
+ 0 to: (self numSlotsOf: array1) - 1 do: [ :i | #foo ].
+ !

Item was changed:
  ----- Method: TSendNode>>isDirective (in category 'testing') -----
  isDirective
  "Preprocessor directive, e.g. a cpp macro"
 
  ^ { #preprocessorExpression: .
  #isDefined:inSmalltalk:comment:ifTrue:ifFalse: .
  #isDefined:inSmalltalk:comment:ifTrue: .
  #isDefinedTrueExpression:inSmalltalk:comment:ifTrue:ifFalse: .
+ #cPreprocessorDirective: .
+ #cppIf:ifTrue:ifFalse: . "oscog compatibility"
+ #cppIf:ifTrue: . "oscog compatibility"
+ #cPreprocessorDirective: "oscog compatibility"
- #cPreprocessorDirective:
  } identityIncludes: selector!

Item was changed:
  ----- Method: VMMaker class>>versionString (in category 'version testing') -----
  versionString
 
  "VMMaker versionString"
 
+ ^'4.18.1'!
- ^'4.17.2'!