[Vm-dev] VM Maker: VMMaker.oscog-eem.2790.mcz

[commits at source.squeak.org]

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!