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

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
1 message Options
Reply | Threaded
Open this post in threaded view
|

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

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

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

Name: VMMaker.oscog-eem.2345
Author: eem
Time: 6 March 2018, 6:49:09.645306 pm
UUID: a9d9ad65-8e38-4936-a5de-2c4be0110c0d
Ancestors: VMMaker.oscog-eem.2344

Cogit:
Fix several slips.  Inline a few trivial methods.

VMMaker:
Nuke an unused sender of cogitClass:

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

Item was changed:
  ----- Method: CogIA32Compiler>>stopsFrom:to: (in category 'generate machine code') -----
  stopsFrom: startAddr to: endAddr
  self
+ cCode: [self me: startAddr ms: self stop et: endAddr - startAddr + 1]
- cCode: [self self me: startAddr ms: self stop et: endAddr - startAddr + 1]
  inSmalltalk:
  [| alignedEnd alignedStart stops |
  stops := self stop << 8 + self stop.
  stops := stops << 16 + stops.
  alignedStart := startAddr + 3 // 4 * 4.
  alignedEnd := endAddr - 1 // 4 * 4.
  alignedEnd <= startAddr
  ifTrue:
  [startAddr to: endAddr do:
  [:addr | objectMemory byteAt: addr put: self stop]]
  ifFalse:
  [startAddr to: alignedStart - 1 do:
  [:addr | objectMemory byteAt: addr put: self stop].
  alignedStart to: alignedEnd by: 4 do:
  [:addr | objectMemory long32At: addr put: stops].
  alignedEnd + 4 to: endAddr do:
  [:addr | objectMemory byteAt: addr put: self stop]]]!

Item was added:
+ ----- Method: CogSSBytecodeFixup>>isTargetOfBackwardBranch (in category 'testing') -----
+ isTargetOfBackwardBranch
+ ^isTargetOfBackwardBranch!

Item was changed:
  ----- Method: CogX64Compiler>>stopsFrom:to: (in category 'generate machine code') -----
  stopsFrom: startAddr to: endAddr
  self
+ cCode: [self me: startAddr ms: self stop et: endAddr - startAddr + 1]
- cCode: [self self me: startAddr ms: self stop et: endAddr - startAddr + 1]
  inSmalltalk:
  [| alignedEnd alignedStart stops |
  stops := self stop << 8 + self stop.
  stops := stops << 16 + stops.
  stops := stops << 32 + stops.
  alignedStart := startAddr + 7 // 8 * 8.
  alignedEnd := endAddr - 1 // 8 * 8.
  alignedEnd <= startAddr
  ifTrue:
  [startAddr to: endAddr do:
  [:addr | objectMemory byteAt: addr put: self stop]]
  ifFalse:
  [startAddr to: alignedStart - 1 do:
  [:addr | objectMemory byteAt: addr put: self stop].
  alignedStart to: alignedEnd by: 8 do:
  [:addr | objectMemory long64At: addr put: stops].
  alignedEnd + 8 to: endAddr do:
  [:addr | objectMemory byteAt: addr put: self stop]]]!

Item was changed:
  ----- Method: Cogit>>initializeFixupAt: (in category 'compile abstract instructions') -----
  initializeFixupAt: targetPC
  "Make sure there's a flagged fixup at the targetPC in fixups.
  Initially a fixup's target is just a flag.  Later on it is replaced with a proper instruction."
  <returnTypeC: #'BytecodeFixup *'>
+ <inline: true>
  (self fixupAt: targetPC) becomeFixup!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>genPushReceiverBytecode (in category 'bytecode generators') -----
  genPushReceiverBytecode
+ ^self ssPushDesc: self ssSelfDescriptor!
- ^self ssPushDesc: self simSelf!

Item was changed:
  ----- Method: StackInterpreter>>maybeSelectorOfMethod: (in category 'debug support') -----
  maybeSelectorOfMethod: methodObj
  "Answer the selector of a method, assuming its penultimate literal is either
  a symbol or a pointer object whose first slot references the method and
  whose second slot is a symbol (i.e. an AdditionalMethodState).  If a Symbol
  can't be found answer nil.  This isn't satisfactory, as it puts a lot of information
  into the VM, but it is needed for adequate crash debugging at Cadence.
  With full blocks as of 9/2016 the last literal of a CompiledBlock is a back pointer
  to the enclosing block or compiled method."
+ <api>
  | ultimateLiteral penultimateLiteral maybeSelector |
  self assert: (objectMemory isOopCompiledMethod: methodObj).
  ultimateLiteral := self ultimateLiteralOf: methodObj.
  (objectMemory isOopCompiledMethod: ultimateLiteral) ifTrue:
  [^self maybeSelectorOfMethod: ultimateLiteral].
  penultimateLiteral := self penultimateLiteralOf: methodObj.
  (objectMemory isWordsOrBytes: penultimateLiteral) ifTrue:
  [^(objectMemory fetchClassTagOfNonImm: penultimateLiteral)
  = (objectMemory fetchClassTagOfNonImm: (objectMemory splObj: SelectorDoesNotUnderstand)) ifTrue:
  [penultimateLiteral]].
  ^((objectMemory isPointers: penultimateLiteral)
  and: [(objectMemory numSlotsOf: penultimateLiteral) >= 2
  and: [(objectMemory fetchPointer: 0 ofObject: penultimateLiteral) = methodObj
  and: [maybeSelector := objectMemory fetchPointer: 1 ofObject: penultimateLiteral.
  (objectMemory isWordsOrBytes: maybeSelector)
  and: [(objectMemory fetchClassTagOfNonImm: maybeSelector)
  = (objectMemory fetchClassTagOfNonImm: (objectMemory splObj: SelectorDoesNotUnderstand))]]]]) ifTrue:
  [maybeSelector]!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genPushReceiverBytecode (in category 'bytecode generators') -----
  genPushReceiverBytecode
  self receiverIsInReceiverResultReg ifTrue:
  [^self ssPushRegister: ReceiverResultReg].
+ ^self ssPushDesc: self ssSelfDescriptor!
- ^self ssPushDesc: self simSelf!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>initializeFixupAt: (in category 'compile abstract instructions') -----
  initializeFixupAt: targetPC
  "Make sure there's a flagged fixup at the targetPC in fixups.
  These are the targets of backward branches.  A backward branch fixup's simStackPtr
  needs to be set when generating the code for the bytecode at the targetPC.
  Initially a fixup's target is just a flag.  Later on it is replaced with a proper instruction."
+ <inline: true>
  | fixup |
  fixup := self fixupAt: targetPC.
  self initializeFixup: fixup!

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>ssSelfDescriptor (in category 'simulation stack') -----
+ ssSelfDescriptor
+ <returnTypeC: #SimStackEntry>
+ <inline: true>
+ ^simStack at: 0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>ssTopDescriptor (in category 'simulation stack') -----
  ssTopDescriptor
  <returnTypeC: #SimStackEntry>
+ <inline: true>
  ^simStack at: simStackPtr!

Item was removed:
- ----- Method: VMMaker class>>makerFor:and:to:platformDir: (in category 'utilities') -----
- makerFor: interpreterClass and: cogitClassOrNil to: srcDirName platformDir: platDirName
- "Initialize a VMMaker to generate the VM to the given target directory. Include plugins in pluginList.
- Example:
- (VMMaker
- generate: NewspeakInterpreter
- to: (FileDirectory default pathFromURI: 'cogvm/newspeaksrc')
- platformDir: (FileDirectory default pathFromURI: 'cogvm/platforms')
- including:#( AsynchFilePlugin FloatArrayPlugin RePlugin B2DPlugin FloatMathPlugin SecurityPlugin
- BMPReadWriterPlugin IA32ABI SocketPlugin BitBltPlugin JPEGReadWriter2Plugin SurfacePlugin
- DSAPrims JPEGReaderPlugin UUIDPlugin DropPlugin LargeIntegers UnixOSProcessPlugin
- FileCopyPlugin Matrix2x3Plugin Win32OSProcessPlugin FilePlugin MiscPrimitivePlugin ZipPlugin))"
- | maker |
- maker := self forPlatform: 'Cross'.
- maker sourceDirectoryName: srcDirName.
- maker platformRootDirectoryName: platDirName.
- maker interpreterClass: interpreterClass.
- cogitClassOrNil ifNotNil: [maker cogitClass: cogitClassOrNil].
- ^maker
- !