VM Maker: VMMaker-dtl.174.mcz

 
Dave Lewis uploaded a new version of VMMaker to project VM Maker:
http://www.squeaksource.com/VMMaker/VMMaker-dtl.174.mcz

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

Name: VMMaker-dtl.174
Author: dtl
Time: 19 May 2010, 10:25:45 am
UUID: 12e0537d-d82e-4aea-ad67-540e24a95261
Ancestors: VMMaker-dtl.173

VMMaker 4.2.1

Remove BytesPerWord BaseHeaderSize class variables from ObjectMemory, and add bytesPerWord instance variable to InterpreterSimulator. BytesPerWord is no longer global, and each interpreter knows the word size of its object memory.

=============== Diff against VMMaker-dtl.173 ===============

Item was added:
+ ----- Method: InterpreterSimulatorLSB64>>initialize (in category 'initialization') -----
+ initialize
+
+ bytesPerWord := 8.
+ super initialize!

Item was changed:
  ----- Method: InterpreterSimulatorMSB>>nextLongFrom: (in category 'initialization') -----
  nextLongFrom: aStream
  "Read a 32- or 64-bit quantity from the given (binary) stream."
 
+ ^ aStream nextNumber: self bytesPerWord!
- ^ aStream nextNumber: BytesPerWord!

Item was changed:
  ----- Method: ObjectMemory class>>initBytesPerWord: (in category 'initialization') -----
+ initBytesPerWord: unused
- initBytesPerWord: nBytes
 
- BytesPerWord := nBytes.
  Byte0Shift := 0.
  Byte1Shift := 8.
  Byte2Shift := 16.
  Byte3Shift := 24.
  Byte4Shift := 32.
  Byte5Shift := 40.
  Byte6Shift := 48.
  Byte7Shift := 56.
 
  Byte0Mask := 16r00000000000000FF.
  Byte1Mask := 16r000000000000FF00.
  Byte2Mask := 16r0000000000FF0000.
  Byte3Mask := 16r00000000FF000000.
  Byte4Mask := 16r000000FF00000000.
  Byte5Mask := 16r0000FF0000000000.
  Byte6Mask := 16r00FF000000000000.
  Byte7Mask := 16rFF00000000000000.
  Bytes3to0Mask := 16r00000000FFFFFFFF.
  Bytes7to4Mask := 16rFFFFFFFF00000000.
 
  Byte1ShiftNegated := Byte1Shift negated.
  Byte3ShiftNegated := Byte3Shift negated.
  Byte4ShiftNegated := Byte4Shift negated.
  Byte5ShiftNegated := Byte5Shift negated.
  Byte7ShiftNegated := Byte7Shift negated!

Item was changed:
  ----- Method: InterpreterSimulator>>printTop: (in category 'debug support') -----
  printTop: n
  "Print important fields of the top n contexts"
  | ctxt classAndSel home top ip sp |
  ctxt := activeContext.
  ^ String streamContents:
  [:strm | 1 to: n do:
  [:i |
  home := (self fetchClassOf: ctxt) = (self splObj: ClassBlockContext)
  ifTrue: [self fetchPointer: HomeIndex ofObject: ctxt]
  ifFalse: [ctxt].
  classAndSel := self
  classAndSelectorOfMethod: (self fetchPointer: MethodIndex ofObject: home)
  forReceiver: (self fetchPointer: ReceiverIndex ofObject: home).
  strm cr; nextPutAll: ctxt hex8.
  ctxt = home ifFalse: [strm nextPutAll: ' [] in'].
  strm space; nextPutAll: (self nameOfClass: classAndSel first).
  strm nextPutAll: '>>'; nextPutAll: (self shortPrint: classAndSel last).
  ctxt = activeContext
+ ifTrue: [ip := instructionPointer - method - (self baseHeaderSize - 2).
- ifTrue: [ip := instructionPointer - method - (BaseHeaderSize - 2).
  sp := self stackPointerIndex - TempFrameStart + 1.
  top := self stackTop]
  ifFalse: [ip := self integerValueOf:
  (self fetchPointer: InstructionPointerIndex ofObject: ctxt).
  sp := self integerValueOf:
  (self fetchPointer: StackPointerIndex ofObject: ctxt).
  top := self longAt: ctxt + (self lastPointerOf: ctxt)].
  strm cr; tab; nextPutAll: 'ip = '; print: ip.
  strm cr; tab; nextPutAll: 'sp = '; print: sp.
  strm cr; tab; nextPutAll: 'top = '; nextPutAll: (self shortPrint: top).
  (ctxt := (self fetchPointer: SenderIndex ofObject: ctxt)) = nilObj
  ifTrue: [^strm contents].
  ].
  ]!

Item was changed:
  ----- Method: InterpreterSimulator>>clipboardWrite:From:At: (in category 'I/O primitives') -----
  clipboardWrite: sz From: actualDataAddress At: ignored
 
+ Clipboard clipboardText: (self stringOf: actualDataAddress - self baseHeaderSize)!
- Clipboard clipboardText: (self stringOf: actualDataAddress - BaseHeaderSize)!

Item was changed:
  ----- Method: ObjectMemory>>baseHeaderSize (in category 'constants') -----
  baseHeaderSize
  "Answer the size of an object memory header word in bytes."
- "Class variable shadows the cpp macro definition in generated code."
 
  self inline: true.
+ ^self cCode: 'BASE_HEADER_SIZE' inSmalltalk: [self bytesPerWord]
- ^self cCode: 'BASE_HEADER_SIZE' inSmalltalk: [BaseHeaderSize]
  !

Item was changed:
  ----- Method: ObjectMemory>>rootBit (in category 'constants') -----
  rootBit
  "Next-to-Top bit"
 
  self inline: true.
  ^self
  cCode: 'ROOT_BIT'
+ inSmalltalk: [1 bitShift: self bytesPerWord * 8 - 2]
- inSmalltalk: [1 bitShift: BytesPerWord*8 - 2]
  !

Item was changed:
  ----- Method: InterpreterSimulatorLSB>>nextLongFrom: (in category 'initialization') -----
  nextLongFrom: aStream
  "Read a 32- or 64-bit quantity from the given (binary) stream."
 
+ ^ aStream nextLittleEndianNumber: self bytesPerWord!
- ^ aStream nextLittleEndianNumber: BytesPerWord!

Item was changed:
  ----- Method: InterpreterSimulatorMSB>>byteAt:put: (in category 'memory access') -----
  byteAt: byteAddress put: byte
  | longWord shift lowBits bpwMinus1 longAddress |
+ bpwMinus1 := self bytesPerWord - 1.
- bpwMinus1 := BytesPerWord-1.
  lowBits := byteAddress bitAnd: bpwMinus1.
  longAddress := byteAddress - lowBits.
  longWord := self longAt: longAddress.
  shift := (bpwMinus1 - lowBits) * 8.
  longWord := longWord
  - (longWord bitAnd: (16rFF bitShift: shift))
  + (byte bitShift: shift).
  self longAt: longAddress put: longWord!

Item was changed:
  ----- Method: InterpreterSimulator>>stringOf: (in category 'debug support') -----
  stringOf: oop
  | size long nLongs chars |
  ^ String streamContents:
  [:strm |
  size := 100 min: (self stSizeOf: oop).
+ nLongs := size - 1 // self bytesPerWord + 1.
- nLongs := size-1//BytesPerWord+1.
  1 to: nLongs do:
+ [:i | long := self longAt: oop + self baseHeaderSize + (i - 1 * self bytesPerWord).
- [:i | long := self longAt: oop + BaseHeaderSize + (i-1*BytesPerWord).
  chars := self charsOfLong: long.
  strm nextPutAll: (i=nLongs
+ ifTrue: [chars copyFrom: 1 to: size - 1 \\ self bytesPerWord + 1]
- ifTrue: [chars copyFrom: 1 to: size-1\\BytesPerWord+1]
  ifFalse: [chars])]]!

Item was changed:
  ----- Method: InterpreterSimulator>>vmPathGet:Length: (in category 'file primitives') -----
  vmPathGet: stringBase Length: stringSize
  | pathName stringOop |
  pathName := Smalltalk vmPath.
+ stringOop := stringBase - self baseHeaderSize. "Due to C call in Interp"
- stringOop := stringBase - BaseHeaderSize. "Due to C call in Interp"
  1 to: stringSize do:
  [:i | self storeByte: i-1 ofObject: stringOop
  withValue: (pathName at: i) asciiValue].
  !

Item was added:
+ ----- Method: InterpreterSimulatorMSB64>>initialize (in category 'initialization') -----
+ initialize
+
+ bytesPerWord := 8.
+ super initialize!

Item was changed:
  ----- Method: InterpreterSimulator>>validateOopsIn: (in category 'testing') -----
  validateOopsIn: object
  | fieldPtr limit former header |
  "for each oop in me see if it is legal"
+ fieldPtr := object + self baseHeaderSize. "first field"
- fieldPtr := object + BaseHeaderSize. "first field"
  limit := object + (self lastPointerOf: object). "a good field"
  [fieldPtr > limit] whileFalse: [
  former := self longAt: fieldPtr.
  (self validOop: former) ifFalse: [self error: 'invalid oop in pointers object'].
+ fieldPtr := fieldPtr + self bytesPerWord].
- fieldPtr := fieldPtr + BytesPerWord].
  "class"
  header := self baseHeader: object.
  (header bitAnd: CompactClassMask) = 0 ifTrue: [
  former := (self classHeader: object) bitAnd: self allButTypeMask.
  (self validOop: former) ifFalse: [self halt]].!

Item was changed:
  ----- Method: InterpreterSimulator>>initialize (in category 'initialization') -----
  initialize
 
  "Initialize the InterpreterSimulator when running the interpreter inside
  Smalltalk. The primary responsibility of this method is to allocate
  Smalltalk Arrays for variables that will be declared as statically-allocated
  global arrays in the translated code."
 
  "initialize class variables"
  ObjectMemory initializeWithBytesToWord: self bytesPerWord.
  Interpreter initialize.
 
  "Note: we must initialize ConstMinusOne differently for simulation,
  due to the fact that the simulator works only with +ve 32-bit values"
  ConstMinusOne := self integerObjectOf: -1.
 
  methodCache := Array new: MethodCacheSize.
  atCache := Array new: AtCacheTotalSize.
  self flushMethodCache.
  rootTable := Array new: RootTableSize.
  weakRoots := Array new: RootTableSize + RemapBufferSize + 100.
  remapBuffer := Array new: RemapBufferSize.
  semaphoresUseBufferA := true.
  semaphoresToSignalA := Array new: SemaphoresToSignalSize.
  semaphoresToSignalB := Array new: SemaphoresToSignalSize.
  externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
  primitiveTable := self class primitiveTable.
  obsoleteNamedPrimitiveTable :=
  CArrayAccessor on: (self class obsoleteNamedPrimitiveTable copyWith: (Array new: 3)).
  obsoleteIndexedPrimitiveTable := CArrayAccessor on:
  (self class obsoleteIndexedPrimitiveTable collect:[:spec|
  CArrayAccessor on:
  (spec ifNil:[Array new: 3]
   ifNotNil:[Array with: spec first with: spec second with: nil])]).
  pluginList := #().
  mappedPluginEntries := #().
 
  "initialize InterpreterSimulator variables used for debugging"
  byteCount := 0.
  sendCount := 0.
  quitBlock := [^ self].
  traceOn := true.
  myBitBlt := BitBltSimulator new setInterpreter: self.
  filesOpen := OrderedCollection new.
+ headerTypeBytes := CArrayAccessor on: (Array with: self bytesPerWord * 2 with: self bytesPerWord with: 0 with: 0).
- headerTypeBytes := CArrayAccessor on: (Array with: BytesPerWord*2 with: BytesPerWord with: 0 with: 0).
  transcript := Transcript.
  displayForm := 'Display has not yet been installed' asDisplayText form.
  !

Item was changed:
  ----- Method: ObjectMemory class>>initializeObjectHeaderConstants (in category 'initialization') -----
  initializeObjectHeaderConstants
 
- BytesPerWord ifNil: [BytesPerWord := 4].  "May get called on fileIn, so supply default"
- BaseHeaderSize := BytesPerWord.
-
  "masks for type field"
  TypeMask := 3.
 
  "type field values"
  HeaderTypeSizeAndClass := 0.
  HeaderTypeClass := 1.
  HeaderTypeFree := 2.
  HeaderTypeShort := 3.
 
  "type field values used during the mark phase of GC"
  HeaderTypeGC := 2.
  GCTopMarker := 3.  "neither an oop, nor an oop+1, this value signals that we have crawled back up to the top of the marking phase."
 
  "Base header word bit fields"
  HashBits := 16r1FFE0000.
  HashBitsOffset := 17.
 
  CompactClassMask := 16r1F000
  !

Item was changed:
  ----- Method: InterpreterSimulator>>writeImageFileIO: (in category 'image save/restore') -----
  writeImageFileIO: numberOfBytesToWrite
  "Actually emit the first numberOfBytesToWrite object memory bytes onto the snapshot."
 
  | headerSize file |
+ self bytesPerWord = 4 ifFalse: [self error: 'Not rewritten for 64 bits yet'].
- BytesPerWord = 4 ifFalse: [self error: 'Not rewritten for 64 bits yet'].
  headerSize := 64.
 
  [
  file := (FileStream fileNamed: imageName) binary.
  file == nil ifTrue: [^nil].
 
  {
  self imageFormatVersion.
  headerSize.
  numberOfBytesToWrite.
  self startOfMemory.
  specialObjectsOop.
  lastHash.
  self ioScreenSize.
  fullScreenFlag.
  extraVMMemory
  }
  do: [:long | self putLong: long toFile: file].
 
  "Pad the rest of the header."
  7 timesRepeat: [self putLong: 0 toFile: file].
 
  "Position the file after the header."
  file position: headerSize.
 
  "Write the object memory."
  1
  to: numberOfBytesToWrite // 4
  do: [:index |
  self
  putLong: (memory at: index)
  toFile: file].
 
  self success: true
  ]
  ensure: [file close]!

Item was changed:
  ----- Method: InterpreterSimulator>>firstIndexableField: (in category 'memory access') -----
  firstIndexableField: oop
  "NOTE: overridden from Interpreter to add coercion to CArray"
 
  | hdr fmt totalLength fixedFields |
  self returnTypeC: 'void *'.
  hdr := self baseHeader: oop.
  fmt := (hdr >> 8) bitAnd: 16rF.
  totalLength := self lengthOf: oop baseHeader: hdr format: fmt.
  fixedFields := self fixedFieldsOf: oop format: fmt length: totalLength.
  fmt < 8 ifTrue:
  [fmt = 6 ifTrue:
  ["32 bit field objects"
+ ^ self cCoerce: (self pointerForOop: oop + self baseHeaderSize + (fixedFields << 2)) to: 'int *'].
- ^ self cCoerce: (self pointerForOop: oop + BaseHeaderSize + (fixedFields << 2)) to: 'int *'].
  "full word objects (pointer or bits)"
+ ^ self cCoerce: (self pointerForOop: oop + self baseHeaderSize + (fixedFields << self shiftForWord)) to: 'oop *']
- ^ self cCoerce: (self pointerForOop: oop + BaseHeaderSize + (fixedFields << self shiftForWord)) to: 'oop *']
  ifFalse:
  ["Byte objects"
+ ^ self cCoerce: (self pointerForOop: oop + self baseHeaderSize + fixedFields) to: 'char *']!
- ^ self cCoerce: (self pointerForOop: oop + BaseHeaderSize + fixedFields) to: 'char *']!

Item was changed:
  ----- Method: InterpreterSimulator>>longPrint: (in category 'debug support') -----
  longPrint: oop
  | lastPtr val lastLong hdrType prevVal |
  (self isIntegerObject: oop) ifTrue: [^ self shortPrint: oop].
  ^ String streamContents:
  [:strm |
+ lastPtr := 64 * self bytesPerWord min: (self lastPointerOf: oop).
- lastPtr := 64*BytesPerWord min: (self lastPointerOf: oop).
  hdrType := self headerType: oop.
  hdrType = 2 ifTrue: [lastPtr := 0].
  prevVal := 0.
+ (self headerStart: oop) to: lastPtr by: self bytesPerWord do:
- (self headerStart: oop) to: lastPtr by: BytesPerWord do:
  [:a | val := self longAt: oop+a.
  (a > 0 and: [(val = prevVal) & (a ~= lastPtr)])
  ifTrue:
+ [prevVal = (self longAt: oop + a - (self bytesPerWord * 2)) ifFalse: [strm cr; nextPutAll: '        ...etc...']]
- [prevVal = (self longAt: oop+a-(BytesPerWord*2)) ifFalse: [strm cr; nextPutAll: '        ...etc...']]
  ifFalse:
  [strm cr; nextPutAll: (a<16 ifTrue: [' ', a hex] ifFalse: [a hex]);
  space; space; space; nextPutAll: val hex8; space; space.
+ a = (self bytesPerWord * 2) negated ifTrue:
- a = (BytesPerWord*2) negated ifTrue:
  [strm nextPutAll: 'size = ' , (val - hdrType) hex].
+ a = self bytesPerWord negated ifTrue:
- a = BytesPerWord negated ifTrue:
  [strm nextPutAll: '<' , (self nameOfClass: (val - hdrType)) , '>'].
  a = 0 ifTrue: [strm cr; tab; nextPutAll: (self dumpHeader: val)].
  a > 0 ifTrue: [strm nextPutAll: (self shortPrint: val)].
+ a = self bytesPerWord ifTrue:
- a = BytesPerWord ifTrue:
  [(self fetchClassOf: oop) = (self splObj: ClassCompiledMethod) ifTrue:
  [strm cr; tab; nextPutAll: (self dumpMethodHeader: val)]]].
  prevVal := val].
+ lastLong := 256 min: (self sizeBitsOf: oop) - self baseHeaderSize.
- lastLong := 256 min: (self sizeBitsOf: oop) - BaseHeaderSize.
  hdrType = 2
  ifTrue:
  ["free" strm cr; nextPutAll: (oop+(self longAt: oop)-2) hex;
  space; space; nextPutAll: (oop+(self longAt: oop)-2) printString]
  ifFalse:
  [(self formatOf: oop) = 3
  ifTrue:
  [strm cr; tab; nextPutAll: '/ next 3 fields are above SP... /'.
+ lastPtr + self bytesPerWord to: lastPtr+(3 * self bytesPerWord) by: self bytesPerWord do:
- lastPtr+BytesPerWord to: lastPtr+(3*BytesPerWord) by: BytesPerWord do:
  [:a | val := self longAt: oop+a.
  strm cr; nextPutAll: a hex;
  space; space; space; nextPutAll: val hex8; space; space.
  (self validOop: val) ifTrue: [strm nextPutAll: (self shortPrint: val)]]]
  ifFalse:
+ [lastPtr + self bytesPerWord to: lastLong by: self bytesPerWord do:
- [lastPtr+BytesPerWord to: lastLong by: BytesPerWord do:
  [:a | val := self longAt: oop+a.
  strm cr; nextPutAll: (a<16 ifTrue: [' ', a hex] ifFalse: [a hex]);
  space; space; space.
  strm nextPutAll: val hex8; space; space;
  nextPutAll: (self charsOfLong: val)]]].
  ]!

Item was changed:
  ----- Method: InterpreterSimulator>>stats (in category 'testing') -----
  stats
  | oop fieldAddr fieldOop last stats v d |
  stats := Bag new.
  oop := self firstObject.
 
  'Scanning the image...' displayProgressAt: Sensor cursorPoint
  from: oop to: endOfMemory
  during: [:bar |
 
  [oop < endOfMemory] whileTrue:
  [(self isFreeObject: oop) ifFalse:
  [stats add: #objects.
  fieldAddr := oop + (self lastPointerOf: oop).
  [fieldAddr > oop] whileTrue:
  [fieldOop := self longAt: fieldAddr.
  (self isIntegerObject: fieldOop)
  ifTrue: [v := self integerValueOf: fieldOop.
  (v between: -16000 and: 16000)
  ifTrue: [stats add: #ints32k]
  ifFalse: [stats add: #intsOther]]
  ifFalse: [fieldOop = nilObj ifTrue: [stats add: #nil]
  ifFalse:
  [d := fieldOop - oop.
  (d between: -16000 and: 16000)
  ifTrue: [stats add: #oops32k]
  ifFalse: [stats add: #oopsOther]]].
+ fieldAddr := fieldAddr - self bytesPerWord]].
- fieldAddr := fieldAddr - BytesPerWord]].
  bar value: oop.
  last := oop.
  last := last.
  oop := self objectAfter: oop]].
  ^ stats sortedElements!

Item was changed:
  ----- Method: SmartSyntaxPluginCodeGenerator>>generateCoerceToObjectFromPtr:on: (in category 'asOop:/asValue:') -----
  generateCoerceToObjectFromPtr: aNode on: aStream
  "This code assumes no named instance variables"
 
  aStream nextPutAll: 'oopForPointer('.
  self emitCExpression: aNode on: aStream.
+ aStream nextPutAll: ') - BASE_HEADER_SIZE'!
- aStream nextPutAll: ') - ', ObjectMemory baseHeaderSize asString!

Item was changed:
+ ----- Method: InterpreterSimulator>>bytesPerWord (in category 'memory access') -----
- ----- Method: InterpreterSimulator>>bytesPerWord (in category 'initialization') -----
  bytesPerWord
+ "BytesPerWord was a class variable in ObjectMemory, permitting each object
+ memory to have its own word size."
- "32 bit VM returns 4, overridden for 64-bit images..."
 
+ ^ bytesPerWord ifNil: [bytesPerWord := 4]!
- ^4!

Item was added:
+ ----- Method: Interpreter>>initializeImageFormatVersionIfNeeded (in category 'image save/restore') -----
+ initializeImageFormatVersionIfNeeded
+ "Set the imageFormatVersionNumber to a default value for this word
+ size. Normally this will have been set at image load time, but set it to
+ a reasonable default if this has not been done."
+
+ self inline: false.
+ imageFormatVersionNumber = 0
+ ifTrue: [self bytesPerWord == 8
+ ifFalse: [imageFormatVersionNumber := 6502]
+ ifTrue: [imageFormatVersionNumber := 68000]]
+ !

Item was changed:
  ----- Method: SmartSyntaxPluginCodeGenerator>>generateCPtrAsOop:on:indent: (in category 'translating builtins') -----
  generateCPtrAsOop: aNode on: aStream indent: anInteger
 
  aStream nextPutAll: '('.
  aStream nextPutAll: 'oopForPointer( '.
  self emitCExpression: aNode receiver on: aStream.
+ aStream nextPutAll: ' ) - BASE_HEADER_SIZE)'!
- aStream nextPutAll: ' ) - ';
- nextPutAll: ObjectMemory baseHeaderSize printString;
- nextPut: $)!

Item was changed:
  ----- Method: InterpreterSimulatorMSB>>charsOfLong: (in category 'debug support') -----
  charsOfLong: long
+ ^ (self bytesPerWord to: 1 by: -1) collect:
- ^ (BytesPerWord to: 1 by: -1) collect:
  [:i | ((long digitAt: i) between: 14 and: 126)
  ifTrue: [(long digitAt: i) asCharacter]
  ifFalse: [$?]]!

Item was changed:
  ----- Method: InterpreterSimulatorMSB>>shortAt: (in category 'memory access') -----
  shortAt: byteAddress
      "Return the half-word at byteAddress which must be even."
  | lowBits bpwMinus2 |
+ bpwMinus2 := self bytesPerWord - 2.
- bpwMinus2 := BytesPerWord-2.
  lowBits := byteAddress bitAnd: bpwMinus2.
  ^ ((self longAt: byteAddress - lowBits)
  bitShift: (lowBits - bpwMinus2) * 8)
  bitAnd: 16rFFFF
  !

Item was changed:
  ----- Method: InterpreterSimulator>>imageFormatVersion (in category 'initialization') -----
  imageFormatVersion
  "The imageFormatVersionNumber variable is initialized in Interpreter class>>declareCVarsIn:
  so provide the value here for simulation."
 
  ^ imageFormatVersionNumber
+ ifNil: [imageFormatVersionNumber := self bytesPerWord == 4
- ifNil: [imageFormatVersionNumber := BytesPerWord == 4
  ifTrue: [6502]
  ifFalse: [68000]]!

Item was changed:
  Interpreter subclass: #InterpreterSimulator
+ instanceVariableNames: 'bytesPerWord byteCount sendCount traceOn myBitBlt displayForm filesOpen imageName pluginList mappedPluginEntries inputSem quitBlock transcript displayView logging'
- instanceVariableNames: 'byteCount sendCount traceOn myBitBlt displayForm filesOpen imageName pluginList mappedPluginEntries inputSem quitBlock transcript displayView logging'
  classVariableNames: ''
  poolDictionaries: ''
  category: 'VMMaker-InterpreterSimulation'!
 
  !InterpreterSimulator commentStamp: 'tpr 5/5/2003 12:24' prior: 0!
  This class defines basic memory access and primitive simulation so that the Interpreter can run simulated in the Squeak environment.  It also defines a number of handy object viewing methods to facilitate pawing around in the object memory.
 
  To see the thing actually run, you could (after backing up this image and changes), execute
 
  (InterpreterSimulator new openOn: Smalltalk imageName) test
 
  and be patient both to wait for things to happen, and to accept various things that may go wrong depending on how large or unusual your image may be.  We usually do this with a small and simple benchmark image. You will probably have more luck using InterpreteSimulatorLSB or InterpreterSimulatorMSB as befits your machine.!

Item was changed:
(excessive method size, no diff calculated)

Item was changed:
  ----- Method: InterpreterSimulatorMSB>>byteAt: (in category 'memory access') -----
  byteAt: byteAddress
  | lowBits bpwMinus1 |
+ bpwMinus1 := self bytesPerWord - 1.
- bpwMinus1 := BytesPerWord-1.
  lowBits := byteAddress bitAnd: bpwMinus1.
  ^ ((self longAt: byteAddress - lowBits)
  bitShift: (lowBits - bpwMinus1) * 8)
  bitAnd: 16rFF!

Item was changed:
  ----- Method: InterpreterSimulator>>shortPrint: (in category 'debug support') -----
  shortPrint: oop
  | name classOop |
  (self isIntegerObject: oop) ifTrue: [^ '=' , (self integerValueOf: oop) printString ,
  ' (' , (self integerValueOf: oop) hex , ')'].
  classOop := self fetchClassOf: oop.
+ (self sizeBitsOf: classOop) = (Metaclass instSize + 1 * self bytesPerWord) ifTrue: [
- (self sizeBitsOf: classOop) = (Metaclass instSize +1*BytesPerWord) ifTrue: [
  ^ 'class ' , (self nameOfClass: oop)].
  name := self nameOfClass: classOop.
  name size = 0 ifTrue: [name := '??'].
  name = 'String' ifTrue: [^ (self stringOf: oop) printString].
  name = 'Symbol' ifTrue: [^ '#' , (self stringOf: oop)].
  name = 'Character' ifTrue: [^ '=' , (Character value: (self integerValueOf:
  (self fetchPointer: 0 ofObject: oop))) printString].
  name = 'UndefinedObject' ifTrue: [^ 'nil'].
  name = 'False' ifTrue: [^ 'false'].
  name = 'True' ifTrue: [^ 'true'].
  name = 'Float' ifTrue: [successFlag := true. ^ '=' , (self floatValueOf: oop) printString].
  name = 'Association' ifTrue: [^ '(' ,
+ (self shortPrint: (self longAt: oop + self baseHeaderSize)) ,
- (self shortPrint: (self longAt: oop + BaseHeaderSize)) ,
  ' -> ' ,
+ (self longAt: oop + self baseHeaderSize + self bytesPerWord) hex8 , ')'].
- (self longAt: oop + BaseHeaderSize + BytesPerWord) hex8 , ')'].
  ('AEIOU' includes: name first)
  ifTrue: [^ 'an ' , name]
  ifFalse: [^ 'a ' , name]!

Item was changed:
  ----- Method: InterpreterSimulatorMSB>>shortAt:put: (in category 'memory access') -----
  shortAt: byteAddress put: a16BitValue
      "Return the half-word at byteAddress which must be even."
  | longWord shift lowBits bpwMinus2 longAddress |
+ bpwMinus2 := self bytesPerWord - 2.
- bpwMinus2 := BytesPerWord-2.
  lowBits := byteAddress bitAnd: bpwMinus2.
  longAddress := byteAddress - lowBits.
  longWord := self longAt: longAddress.
  shift := (bpwMinus2 - lowBits) * 8.
  longWord := longWord
  - (longWord bitAnd: (16rFFFF bitShift: shift))
  + (a16BitValue bitShift: shift).
  self longAt: longAddress put: longWord
  !

Item was changed:
  ----- Method: InterpreterSimulator>>nameOfClass: (in category 'debug support') -----
  nameOfClass: classOop
+ (self sizeBitsOf: classOop) = (Metaclass instSize + 1 * self bytesPerWord) ifTrue:
- (self sizeBitsOf: classOop) = (Metaclass instSize +1*BytesPerWord) ifTrue:
  [^ (self nameOfClass:
  (self fetchPointer: 5 "thisClass" ofObject: classOop)) , ' class'].
  ^ self stringOf: (self fetchPointer: 6 "name" ofObject: classOop)!

Item was changed:
  ----- Method: InterpreterSimulator>>printStackTemps:onStream: (in category 'debug support') -----
  printStackTemps: ctxt onStream: strm
  | home cMethod nArgs nTemps oop |
  home := (self fetchClassOf: ctxt) = (self splObj: ClassBlockContext)
  ifTrue: [self fetchPointer: HomeIndex ofObject: ctxt]
  ifFalse: [ctxt].
  cMethod := self fetchPointer: MethodIndex ofObject: home.
  nArgs := nTemps := 0.
 
  home = ctxt ifTrue:
  [strm cr; tab; nextPutAll: 'args: '.
  nArgs := self argumentCountOf: cMethod.
  1 to: nArgs do:
  [:i | oop := self fetchPointer: TempFrameStart + i-1 ofObject: ctxt.
  strm nextPutAll: oop hex; space].
 
  strm cr; tab; nextPutAll: 'temps: '.
  nTemps := self tempCountOf: cMethod.
  nArgs+1 to: nTemps do:
  [:i | oop := self fetchPointer: TempFrameStart + i-1 ofObject: ctxt.
  strm nextPutAll: oop hex; space]].
 
  strm cr; tab; nextPutAll: 'stack: '.
+ nTemps + 1 to: (self lastPointerOf: ctxt)//self bytesPerWord - TempFrameStart do:
- nTemps + 1 to: (self lastPointerOf: ctxt)//BytesPerWord - TempFrameStart do:
  [:i | oop := self fetchPointer: TempFrameStart + i-1 ofObject: ctxt.
  strm nextPutAll: oop hex; space].
  !

Item was added:
+ ----- Method: InterpreterSimulator>>bytesPerWord: (in category 'memory access') -----
+ bytesPerWord: fourOrEight
+ "BytesPerWord was a class variable in ObjectMemory, permitting each object
+ memory to have its own word size."
+
+ bytesPerWord := fourOrEight!

Item was changed:
  ----- Method: Interpreter>>interpret (in category 'interpreter shell') -----
  interpret
  "This is the main interpreter loop. It normally loops forever, fetching and executing bytecodes. When running in the context of a browser plugin VM, however, it must return control to the browser periodically. This should done only when the state of the currently running Squeak thread is safely stored in the object heap. Since this is the case at the moment that a check for interrupts is performed, that is when we return to the browser if it is time to do so. Interrupt checks happen quite frequently."
 
  self inline: false. "should not be inlined into any senders"
  "record entry time when running as a browser plug-in"
  self browserPluginInitialiseIfNeeded.
+ self initializeImageFormatVersionIfNeeded.
  self internalizeIPandSP.
  self fetchNextBytecode.
  [true] whileTrue: [self dispatchOn: currentBytecode in: BytecodeTable].
  localIP := localIP - 1.  "undo the pre-increment of IP before returning"
  self externalizeIPandSP.
  !

Item was changed:
  ----- Method: InterpreterSimulator>>validate: (in category 'testing') -----
  validate: oop
  | header type cc sz fmt nextChunk |
  header := self longAt: oop.
  type := header bitAnd: 3.
  type = 2 ifFalse: [type = (self rightType: header) ifFalse: [self halt]].
  sz := (header bitAnd: self sizeMask) >> 2.
  (self isFreeObject: oop)
  ifTrue: [ nextChunk := oop + (self sizeOfFree: oop) ]
  ifFalse: [  nextChunk := oop + (self sizeBitsOf: oop) ].
  nextChunk > endOfMemory
  ifTrue: [oop = endOfMemory ifFalse: [self halt]].
  (self headerType: nextChunk) = 0 ifTrue: [
+ (self headerType: (nextChunk + (self bytesPerWord * 2))) = 0 ifFalse: [self halt]].
- (self headerType: (nextChunk + (BytesPerWord*2))) = 0 ifFalse: [self halt]].
  (self headerType: nextChunk) = 1 ifTrue: [
+ (self headerType: (nextChunk + self bytesPerWord)) = 1 ifFalse: [self halt]].
- (self headerType: (nextChunk + BytesPerWord)) = 1 ifFalse: [self halt]].
  type = 2 ifTrue:
  ["free block" ^ self].
  fmt := (header >> 8) bitAnd: 16rF.
  cc := (header >> 12) bitAnd: 31.
  cc > 16 ifTrue: [self halt]. "up to 32 are legal, but not used"
  type = 0 ifTrue:
  ["three-word header"
+ ((self longAt: oop - self bytesPerWord) bitAnd: 3) = type ifFalse: [self halt].
+ ((self longAt: oop-(self bytesPerWord * 2)) bitAnd: 3) = type ifFalse: [self halt].
+ ((self longAt: oop - self bytesPerWord) = type) ifTrue: [self halt]. "Class word is 0"
- ((self longAt: oop-BytesPerWord) bitAnd: 3) = type ifFalse: [self halt].
- ((self longAt: oop-(BytesPerWord*2)) bitAnd: 3) = type ifFalse: [self halt].
- ((self longAt: oop-BytesPerWord) = type) ifTrue: [self halt]. "Class word is 0"
  sz = 0 ifFalse: [self halt]].
  type = 1 ifTrue:
  ["two-word header"
+ ((self longAt: oop - self bytesPerWord) bitAnd: 3) = type ifFalse: [self halt].
- ((self longAt: oop-BytesPerWord) bitAnd: 3) = type ifFalse: [self halt].
  cc > 0 ifTrue: [sz = 1 ifFalse: [self halt]].
  sz = 0 ifTrue: [self halt]].
  type = 3 ifTrue:
  ["one-word header"
  cc = 0 ifTrue: [self halt]].
  fmt = 5 ifTrue: [self halt].
  fmt = 7 ifTrue: [self halt].
  fmt >= 12 ifTrue:
  ["CompiledMethod -- check for integer header"
+ (self isIntegerObject: (self longAt: oop + self bytesPerWord)) ifFalse: [self halt]].!
- (self isIntegerObject: (self longAt: oop + BytesPerWord)) ifFalse: [self halt]].!

Item was changed:
  ----- Method: Interpreter class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
  aCCodeGenerator addHeaderFile:'<setjmp.h>'.
  aCCodeGenerator
  var: #interpreterProxy
  type: #'struct VirtualMachine*'.
  aCCodeGenerator
  var: #primitiveTable
  declareC: 'void *primitiveTable[', (MaxPrimitiveIndex +2) printString, '] = ', self primitiveTableString.
  aCCodeGenerator
  var: #primitiveFunctionPointer
  declareC: 'void *primitiveFunctionPointer' . "xxxx FIX THIS STUPIDITY xxxx - ikp. What he means is use a better type than void *, apparently - tpr"
  aCCodeGenerator
  var: #methodCache
  declareC: 'long methodCache[', (MethodCacheSize + 1) printString, ']'.
  aCCodeGenerator
  var: #atCache
  declareC: 'sqInt atCache[', (AtCacheTotalSize + 1) printString, ']'.
  aCCodeGenerator var: #statGCTime type: #'sqLong'.
  aCCodeGenerator var: #statFullGCMSecs type: #'sqLong'.
  aCCodeGenerator var: #statIGCDeltaTime type: #'sqLong'.
  aCCodeGenerator var: #statIncrGCMSecs type: #'sqLong'.
  aCCodeGenerator var: #localIP type: #'char*'.
  aCCodeGenerator var: #localSP type: #'char*'.
  aCCodeGenerator var: #showSurfaceFn type: #'void*'.
  aCCodeGenerator var: 'semaphoresToSignalA'
  declareC: 'sqInt semaphoresToSignalA[', (SemaphoresToSignalSize + 1) printString, ']'.
  aCCodeGenerator var: 'semaphoresToSignalB'
  declareC: 'sqInt semaphoresToSignalB[', (SemaphoresToSignalSize + 1) printString, ']'.
  aCCodeGenerator
  var: #compilerHooks
  declareC: 'sqInt (*compilerHooks[', (CompilerHooksSize + 1) printString, '])()'.
  aCCodeGenerator
  var: #interpreterVersion
  declareC: 'const char *interpreterVersion = "', SmalltalkImage current datedVersion, ' [', SmalltalkImage current lastUpdateString,']"'.
  aCCodeGenerator
  var: #obsoleteIndexedPrimitiveTable
  declareC: 'char* obsoleteIndexedPrimitiveTable[][3] = ', self obsoleteIndexedPrimitiveTableString.
  aCCodeGenerator
  var: #obsoleteNamedPrimitiveTable
  declareC: 'const char* obsoleteNamedPrimitiveTable[][3] = ', self obsoleteNamedPrimitiveTableString.
  aCCodeGenerator
  var: #externalPrimitiveTable
  declareC: 'void *externalPrimitiveTable[', (MaxExternalPrimitiveTableSize + 1) printString, ']'.
 
  self declareCAsOop: {
  #instructionPointer .
  #method .
  #newMethod .
  #activeContext .
  #theHomeContext .
  #stackPointer }
  in: aCCodeGenerator.
 
  aCCodeGenerator
  var: #jmpBuf
  declareC: 'jmp_buf jmpBuf[', (MaxJumpBuf + 1) printString, ']'.
  aCCodeGenerator
  var: #suspendedCallbacks
  declareC: 'sqInt suspendedCallbacks[', (MaxJumpBuf + 1) printString, ']'.
  aCCodeGenerator
  var: #suspendedMethods
  declareC: 'sqInt suspendedMethods[', (MaxJumpBuf + 1) printString, ']'.
 
+ "Reinitialized at interpreter entry by #initializeImageFormatVersion"
  aCCodeGenerator
  var: #imageFormatVersionNumber
+ declareC: 'sqInt imageFormatVersionNumber = 0'!
- declareC: 'sqInt imageFormatVersionNumber = ',
- (BytesPerWord == 4
- ifTrue: ['6502']
- ifFalse: ['68000'])!

Item was changed:
  ----- Method: ObjectMemory>>bytesPerWord (in category 'constants') -----
  bytesPerWord
  "Answer the size of an object memory word in bytes."
- "Class variable shadows the cpp macro definition in generated code."
 
  self inline: true.
+ ^self
+ cCode: 'BYTES_PER_WORD'
+ inSmalltalk: [self subclassResponsibility "InterpreterSimulator"]
- ^self cCode: 'BYTES_PER_WORD' inSmalltalk: [BytesPerWord]
  !

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

Item was removed:
- ----- Method: ObjectMemory class>>bytesPerWord (in category 'accessing') -----
- bytesPerWord
- "Answer the width of an object pointer, in bytes."
-
- ^BytesPerWord!

Item was removed:
- ----- Method: InterpreterSimulatorLSB64>>bytesPerWord (in category 'initialization') -----
- bytesPerWord
- "overridden for 64-bit images..."
-
- ^ 8!

Item was removed:
- ----- Method: InterpreterSimulatorMSB64>>bytesPerWord (in category 'initialization') -----
- bytesPerWord
- "overridden for 64-bit images..."
-
- ^ 8!

Item was removed:
- ----- Method: ObjectMemory class>>baseHeaderSize (in category 'accessing') -----
- baseHeaderSize
- "To support SmartSyntaxPluginCodeGenerator"
- ^BaseHeaderSize!