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

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

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

Name: VMMaker.oscog-eem.2790
Author: eem
Time: 16 August 2020, 4:25:54.430017 pm
UUID: c254cfd5-e456-417a-bad8-bb026d11b73e
Ancestors: VMMaker.oscog-eem.2789

Interpreter cleanup
Eliminate assertClassOf:is:.
Delete obsolete primitiveVMProfileInfoInto.
Simplify bytecodePrimPointX/Y to avoid primFailCode.

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

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveImageName (in category 'other primitives') -----
  primitiveImageName
+ "When called with a single string argument, record the string as the current image file name.
+ When called with zero arguments, return a string containing the current image file name."
- "When called with a single string argument, record the string as the current image file name. When called with zero arguments, return a string containing the current image file name."
 
+ | s isString sCRIfn okToRename sz |
+ <var: #sCRIfn type: #'void *'>
+ argumentCount = 1 ifTrue:
+ [s := self stackTop.
+ isString := self isInstanceOfClassByteString: s.
+ isString ifFalse:
+ [^self primitiveFailFor: PrimErrBadArgument].
- | s sz sCRIfn okToRename |
- <var: #sCRIfn type: 'void *'>
- argumentCount = 1 ifTrue: [
  "If the security plugin can be loaded, use it to check for rename permission.
+ If not, assume it's ok"
- If not, assume it's ok"
  sCRIfn := self ioLoadFunction: 'secCanRenameImage' From: 'SecurityPlugin'.
  sCRIfn ~= 0 ifTrue:
  [okToRename := self cCode: '((sqInt (*)(void))sCRIfn)()'
  inSmalltalk: [self dispatchMappedPluginEntry: sCRIfn].
+ okToRename ifFalse:
+ [^self primitiveFailFor: PrimErrUnsupported]].
+ self imageNamePut: (s + objectMemory baseHeaderSize) Length: (objectMemory numBytesOf: s).
+ ^self pop: 1].  "pop s, leave rcvr on stack"
+
+ "A char *ioImageName(void) style interface would be less cumbersome."
+ sz := self imageNameSize.
+ s := objectMemory instantiateClass: (objectMemory splObj: ClassByteString) indexableSize: sz.
+ self imageNameGet: (s + objectMemory baseHeaderSize) Length: sz.
+ self methodReturnValue: s!
- okToRename ifFalse:
- [^self primitiveFail]].
- s := self stackTop.
- self assertClassOf: s is: (objectMemory splObj: ClassByteString).
- self successful ifTrue: [
- sz := self stSizeOf: s.
- self imageNamePut: (s + objectMemory baseHeaderSize) Length: sz.
- self pop: 1.  "pop s, leave rcvr on stack"
- ].
- ] ifFalse: [
- sz := self imageNameSize.
- s := objectMemory instantiateClass: (objectMemory splObj: ClassByteString) indexableSize: sz.
- self imageNameGet: (s + objectMemory baseHeaderSize) Length: sz.
- self pop: 1 thenPush: s
- ]!

Item was removed:
- ----- Method: InterpreterPrimitives>>primitiveVMProfileInfoInto (in category 'process primitives') -----
- primitiveVMProfileInfoInto
- "Primitive. Answer whether the profiler is running or not.
- If the argument is an Array of suitable size fill it with the following information:
- 1. the addresses of the first element of the VM histogram (the first address in the executable)
- 2. the address following the last element (the last address in the executable, excluding dynamically linked libraries)
- 3. the size of the VM histogram in bins (each bin is a 4 byte unsigned long)
- 4. the size of the VM histogram in bins (each bin is a 4 byte unsigned long)"
- | info running exeStart exeLimit vmBins easBins |
- <var: #exeStart type: #'char *'>
- <var: #exeLimit type: #'char *'>
- <var: #vmBins type: #long>
- <var: #easBins type: #long>
- self success: argumentCount = 1.
- self successful ifTrue:
- [info := self stackObjectValue: 0].
- self successful ifTrue:
- [info ~= objectMemory nilObject ifTrue:
- [self assertClassOf: info is: (objectMemory splObj: ClassArray).
- self success: (objectMemory numSlotsOf: info) >= 4]].
- self successful ifFalse:
- [^nil].
-
- self cCode: 'ioProfileStatus(&running,&exeStart,&exeLimit,0,&vmBins,0,&easBins)'
- inSmalltalk: [running := exeStart := exeLimit := vmBins := easBins := 0].
- info ~= objectMemory nilObject ifTrue:
- [objectMemory storePointerUnchecked: 0
- ofObject: info
- withValue: (objectMemory integerObjectOf: (self oopForPointer: exeStart)).
- objectMemory storePointerUnchecked: 1
- ofObject: info
- withValue: (objectMemory integerObjectOf: (self oopForPointer: exeLimit)).
- objectMemory storePointerUnchecked: 2
- ofObject: info
- withValue: (objectMemory integerObjectOf: vmBins).
- objectMemory storePointerUnchecked: 3
- ofObject: info
- withValue: (objectMemory integerObjectOf: easBins)].
- self pop: 2 thenPushBool: running!

Item was removed:
- ----- Method: StackInterpreter>>assertClassOf:is: (in category 'utilities') -----
- assertClassOf: oop is: classOop
- "Succeed if oop is an instance of the given class. Fail if the object is an integer."
- | ok |
- <inline: true>
- ok := objectMemory isNonImmediate: oop.
- ok ifTrue:
- [ok := objectMemory isClassOfNonImm: oop equalTo: classOop].
- self success: ok!

Item was changed:
  ----- Method: StackInterpreter>>bytecodePrimPointX (in category 'common selector sends') -----
  bytecodePrimPointX
 
+ | rcvr ok |
- | rcvr |
  self initPrimCall.
  rcvr := self internalStackTop.
+ (objectMemory isNonImmediate: rcvr) ifTrue:
+ [ok := objectMemory isClassOfNonImm: rcvr equalTo: (objectMemory splObj: ClassPoint).
+ ok ifTrue:
+ [self internalStackTopPut: (objectMemory fetchPointer: XIndex ofObject: rcvr).
+ ^self fetchNextBytecode]].
- self assertClassOf: rcvr is: (objectMemory splObj: ClassPoint).
- self successful ifTrue:
- [self internalStackTopPut: (objectMemory fetchPointer: XIndex ofObject: rcvr).
- ^self fetchNextBytecode "success"].
- primFailCode := 0.
 
  messageSelector := self specialSelector: 30.
  argumentCount := 0.
  self normalSend!

Item was changed:
  ----- Method: StackInterpreter>>bytecodePrimPointY (in category 'common selector sends') -----
  bytecodePrimPointY
 
+ | rcvr ok |
- | rcvr |
  self initPrimCall.
  rcvr := self internalStackTop.
+ (objectMemory isNonImmediate: rcvr) ifTrue:
+ [ok := objectMemory isClassOfNonImm: rcvr equalTo: (objectMemory splObj: ClassPoint).
+ ok ifTrue:
+ [self internalStackTopPut: (objectMemory fetchPointer: YIndex ofObject: rcvr).
+ ^self fetchNextBytecode]].
- self assertClassOf: rcvr is: (objectMemory splObj: ClassPoint).
- self successful ifTrue:
- [self internalStackTopPut: (objectMemory fetchPointer: YIndex ofObject: rcvr).
- ^self fetchNextBytecode "success"].
- primFailCode := 0.
 
  messageSelector := self specialSelector: 31.
  argumentCount := 0.
  self normalSend!