[Vm-dev] VM Maker: VMMaker.oscogSPC-eem.2129.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Feb 14 18:17:37 UTC 2017


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

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

Name: VMMaker.oscogSPC-eem.2129
Author: eem
Time: 14 February 2017, 10:16:49.684561 am
UUID: dd569427-3aa5-40f1-963d-0637233a91a9
Ancestors: VMMaker.oscogSPC-eem.2128, VMMaker.oscog-rsf.2128

InterpreterPrimitives:
Fix slip in primitiveSmallFloatSquareRoot

64-bit Cogit:
Fix generation of CallR.

Merge with VMMaker.oscog-rsf.2127 & 2128.

=============== Diff against VMMaker.oscogSPC-eem.2128 ===============

Item was added:
+ ----- Method: CoInterpreter>>lowcodeDoCallout: (in category 'inline primitive ffi abi') -----
+ lowcodeDoCallout: functionPointer
+ 	<option: #LowcodeVM>
+ 	<var: #functionPointer type: #'char*' >
+ 	self undoFetchNextBytecode.
+ 	self externalizeIPandSP.
+ 	self lowcodeCalloutState: lowcodeCalloutState callFunction: functionPointer.
+ 	instructionPointer = cogit ceReturnToInterpreterPC ifTrue: [
+ 		instructionPointer := self iframeSavedIP: framePointer.
+ 	].
+ 	self internalizeIPandSP.
+ 	self reloadLowcodeStateAfterCallout.
+ 	self fetchNextBytecode.
+ 	^ self lowcodeCalloutStateFetchResultFloat32: lowcodeCalloutState!

Item was added:
+ ----- Method: CogIA32Compiler>>registerToSaveIP (in category 'abi') -----
+ registerToSaveIP
+ 	"Temporary register used for fetching the instruction pointer. This should
+ 	not be used for passing parameters in a standard ABI"
+ 	<option: #LowcodeVM>
+ 	^ ClassReg!

Item was added:
+ ----- Method: CogMethod>>counters (in category 'accessing') -----
+ counters
+ 	^ 0!

Item was changed:
  ----- Method: CogX64Compiler>>computeMaximumSize (in category 'generate machine code') -----
(excessive size, no diff calculated)

Item was changed:
  ----- Method: CogX64Compiler>>concretizeCallR (in category 'generate machine code') -----
  concretizeCallR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
+ 	| reg |
- 	| reg skip |
  	reg := operands at: 0.
- 	(reg <= 7)
- 		ifTrue: [skip := 0]
- 		ifFalse: [skip := 1. machineCode at: 0 put: (self rexw: false r: 0 x: 0 b: reg). (skip := 1)].
- 			
  	machineCode
+ 		at: 0 put: (self rexR: 0 x: 0 b: reg);
+ 		at: 1 put: 16rFF;
+ 		at: 2 put: (self mod: ModReg RM: reg RO: 2).
+ 	^machineCodeSize := 3!
- 		at: skip + 0 put: 16rFF;
- 		at: skip + 1 put: (self mod: ModReg RM: reg RO: 2).
- 	^machineCodeSize := 2!

Item was added:
+ ----- Method: CogX64Compiler>>registerToSaveIP (in category 'abi') -----
+ registerToSaveIP
+ 	"Temporary register used for fetching the instruction pointer. This should
+ 	not be used for passing parameters in a standard ABI"
+ 	<option: #LowcodeVM>
+ 	^ R15!

Item was changed:
  ----- Method: Cogit>>checkIfValidOopRefAndTarget:pc:cogMethod: (in category 'garbage collection') -----
  checkIfValidOopRefAndTarget: annotation pc: mcpc cogMethod: cogMethod
  	"Check for a valid object reference, if any, at a map entry.  Answer a code unique to each error for debugging."
  	<var: #mcpc type: #'char *'>
  	<var: #nsSendCache type: #'NSSendCache *'>
  	| literal entryPoint |
  	annotation = IsObjectReference ifTrue:
  		[literal := literalsManager fetchLiteralAtAnnotatedAddress: mcpc asUnsignedInteger using: backEnd.
  		 (self asserta: (objectRepresentation checkValidOopReference: literal)) ifFalse:
  			[^1].
  		((objectRepresentation couldBeObject: literal)
  		 and: [objectMemory isReallyYoungObject: literal]) ifTrue:
  			[(self asserta: (self cCoerceSimple: cogMethod to: #'CogMethod *') cmRefersToYoung) ifFalse:
  				[^2]]].
  
  	NewspeakVM ifTrue:
  		[annotation = IsNSSendCall ifTrue:
  			[| nsSendCache classTag enclosingObject nsTargetMethod |
  			nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
  			(self asserta: (objectRepresentation checkValidOopReference: nsSendCache selector)) ifFalse:
  				[^9].
  			classTag := nsSendCache classTag.
  			(self asserta: (classTag = 0 or: [objectRepresentation validInlineCacheTag: classTag])) ifFalse:
  				[^10].
  			enclosingObject := nsSendCache enclosingObject.
  			(self asserta: (enclosingObject = 0 or: [objectRepresentation checkValidOopReference: enclosingObject])) ifFalse:
  				[^11].
  			entryPoint := nsSendCache target.
  			entryPoint ~= 0 ifTrue: [
  				nsTargetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
  				(self asserta: (nsTargetMethod cmType = CMMethod)) ifFalse:
  					[^12]]]].
  
  	(self isPureSendAnnotation: annotation) ifTrue:
  		[(self asserta: (self cCoerceSimple: cogMethod to: #'CogMethod *') cmType = CMMethod) ifFalse:
  			[^3].
  		 self entryCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
  			[:entryPt :cacheTag :tagCouldBeObject|
  			entryPoint := entryPt.
  			tagCouldBeObject
  				ifTrue:
  					[(objectRepresentation couldBeObject: cacheTag)
  						ifTrue:
  							[(self asserta: (objectRepresentation checkValidOopReference: cacheTag)) ifFalse:
  								[^4]]
  						ifFalse:
  							[(self asserta: (objectRepresentation validInlineCacheTag: cacheTag)) ifFalse:
  								[^5]].
  					((objectRepresentation couldBeObject: cacheTag)
  					 and: [objectMemory isReallyYoungObject: cacheTag]) ifTrue:
  						[(self asserta: (self cCoerceSimple: cogMethod to: #'CogMethod *') cmRefersToYoung) ifFalse:
  							[^6]]]
  				ifFalse:
  					[(self inlineCacheTagsAreIndexes
+ 					  and: [self entryPointTagIsSelector: entryPoint])
- 					  and: [self self entryPointTagIsSelector: entryPoint])
  						ifTrue:
  							[cacheTag signedIntFromLong < 0
  								ifTrue:
  									[cacheTag signedIntFromLong negated > NumSpecialSelectors ifTrue:
  										[^7]]
  								ifFalse:
  									[cacheTag >= (objectMemory literalCountOf: enumeratingCogMethod methodObject) ifTrue:
  										[^8]]]
  						ifFalse:
  							[(self asserta: (objectRepresentation validInlineCacheTag: cacheTag)) ifFalse:
  								[^9]]]].
  		entryPoint > methodZoneBase ifTrue:
  			["It's a linked send; find which kind."
  			 self targetMethodAndSendTableFor: entryPoint annotation: annotation into:
  					[:targetMethod :sendTable|
  					 (self asserta: (targetMethod cmType = CMMethod
  								   or: [targetMethod cmType = CMClosedPIC
  								   or: [targetMethod cmType = CMOpenPIC]])) ifFalse:
  						[^10]]]].
  	^0 "keep scanning"!

Item was changed:
  ----- Method: Cogit>>genFFICalloutTrampoline (in category 'initialization') -----
  genFFICalloutTrampoline
  	<option: #LowcodeVM>
  	| startAddress |
  	opcodeIndex := 0.
  	backEnd hasLinkRegister ifTrue: [
  		self MoveR: LinkReg Aw: coInterpreter instructionPointerAddress
  	] ifFalse: [
+ 		self PopR: backEnd registerToSaveIP.
+ 		self MoveR: backEnd registerToSaveIP Aw: coInterpreter instructionPointerAddress
- 		self PopR: ClassReg.
- 		self MoveR: ClassReg Aw: coInterpreter instructionPointerAddress
  	].
  
  	self CallR: TempReg.
  
  	backEnd hasLinkRegister ifTrue: [
  		self MoveAw: coInterpreter instructionPointerAddress R: LinkReg 
  	] ifFalse: [
+ 		self MoveAw: coInterpreter instructionPointerAddress R: backEnd registerToSaveIP.
+ 		self PushR: backEnd registerToSaveIP.
- 		self MoveAw: coInterpreter instructionPointerAddress R: ClassReg.
- 		self PushR: ClassReg.
  	].
  
  	self RetN: 0.
  
  	startAddress := methodZoneBase.
  	self outputInstructionsForGeneratedRuntimeAt: startAddress.
  	self recordGeneratedRunTime: 'ceFFICalloutTrampoline' address: startAddress.
  	self recordRunTimeObjectReferences.
  	^ startAddress
  !

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveSmallFloatSquareRoot (in category 'arithmetic float primitives') -----
  primitiveSmallFloatSquareRoot
  	<option: #Spur64BitMemoryManager>
+ 	<var: #rcvr type: #double>
  	| rcvr |
  	rcvr := objectMemory smallFloatValueOf: self stackTop.
  	rcvr >= 0.0
  		ifTrue: [self stackTopPut: (objectMemory floatObjectOf: rcvr sqrt)]
  		ifFalse: [self primitiveFail]!

Item was removed:
- ----- Method: StackInterpreter>>lowcodeCallout:structureResult: (in category 'inline primitive ffi abi') -----
- lowcodeCallout: functionPointer structureResult: resultPointer
- 	<option: #LowcodeVM>
- 	<var: #functionPointer type: #'char*' >
- 	<var: #resultPointer type: #'char*' >
- 	self internalPushShadowCallStackPointer: resultPointer.
- 	self externalizeIPandSP.
-    self lowcodeCalloutState: lowcodeCalloutState callFunction: functionPointer.
-    self internalizeIPandSP.
- 	self reloadLowcodeStateAfterCallout.
- 	^ self lowcodeCalloutStateFetchResultStructure: lowcodeCalloutState!

Item was removed:
- ----- Method: StackInterpreter>>lowcodeCalloutFloat32Result: (in category 'inline primitive ffi abi') -----
- lowcodeCalloutFloat32Result: functionPointer
- 	<option: #LowcodeVM>
- 	<var: #functionPointer type: #'char*' >
- 	self externalizeIPandSP.
-    self lowcodeCalloutState: lowcodeCalloutState callFunction: functionPointer.
-    self internalizeIPandSP.
- 	self reloadLowcodeStateAfterCallout.
- 	^ self lowcodeCalloutStateFetchResultFloat32: lowcodeCalloutState!

Item was removed:
- ----- Method: StackInterpreter>>lowcodeCalloutFloat64Result: (in category 'inline primitive ffi abi') -----
- lowcodeCalloutFloat64Result: functionPointer
- 	<option: #LowcodeVM>
- 	<var: #functionPointer type: #'char*' >
- 	self externalizeIPandSP.
-    self lowcodeCalloutState: lowcodeCalloutState callFunction: functionPointer.
-    self internalizeIPandSP.
- 	self reloadLowcodeStateAfterCallout.
- 	^ self lowcodeCalloutStateFetchResultFloat64: lowcodeCalloutState!

Item was removed:
- ----- Method: StackInterpreter>>lowcodeCalloutInt32Result: (in category 'inline primitive ffi abi') -----
- lowcodeCalloutInt32Result: functionPointer
- 	<option: #LowcodeVM>
- 	<var: #functionPointer type: #'char*' >
- 	self externalizeIPandSP.
-    self lowcodeCalloutState: lowcodeCalloutState callFunction: functionPointer.
-    self internalizeIPandSP.
- 	self reloadLowcodeStateAfterCallout.
- 	^ self lowcodeCalloutStateFetchResultInt32: lowcodeCalloutState!

Item was removed:
- ----- Method: StackInterpreter>>lowcodeCalloutInt64Result: (in category 'inline primitive ffi abi') -----
- lowcodeCalloutInt64Result: functionPointer
- 	<option: #LowcodeVM>
- 	<var: #functionPointer type: #'char*' >
- 	self externalizeIPandSP.
-    self lowcodeCalloutState: lowcodeCalloutState callFunction: functionPointer.
-    self internalizeIPandSP.
- 	self reloadLowcodeStateAfterCallout.
- 	^ self lowcodeCalloutStateFetchResultInt64: lowcodeCalloutState!

Item was removed:
- ----- Method: StackInterpreter>>lowcodeCalloutPointerResult: (in category 'inline primitive ffi abi') -----
- lowcodeCalloutPointerResult: functionPointer
- 	<option: #LowcodeVM>
- 	<var: #functionPointer type: #'char*' >
- 	self externalizeIPandSP.
-    self lowcodeCalloutState: lowcodeCalloutState callFunction: functionPointer.
-    self internalizeIPandSP.
- 	self reloadLowcodeStateAfterCallout.
- 	^ self lowcodeCalloutStateFetchResultPointer: lowcodeCalloutState!

Item was added:
+ ----- Method: StackInterpreter>>lowcodeDoCallout: (in category 'inline primitive ffi abi') -----
+ lowcodeDoCallout: functionPointer
+ 	<option: #LowcodeVM>
+ 	<var: #functionPointer type: #'char*' >
+ 	self undoFetchNextBytecode.
+ 	self externalizeIPandSP.
+ 	self lowcodeCalloutState: lowcodeCalloutState callFunction: functionPointer.
+ 	self internalizeIPandSP.
+ 	self reloadLowcodeStateAfterCallout.
+ 	self fetchNextBytecode.
+ 	^ self lowcodeCalloutStateFetchResultFloat32: lowcodeCalloutState!

Item was removed:
- ----- Method: StackInterpreter>>lowcodePrimitivePerformCallFloat32 (in category 'inline primitive generated code') -----
- lowcodePrimitivePerformCallFloat32
- 	<option: #LowcodeVM>	"Lowcode instruction generator"
- 	| result function |
- 	<var: #result type: #'float' >
- 	function := extA.
- 
- 	result := self lowcodeCalloutFloat32Result: (self cCoerce: function to: #'char*').
- 
- 	self internalPushFloat32: result.
- 	extA := 0.
- 
- !

Item was removed:
- ----- Method: StackInterpreter>>lowcodePrimitivePerformCallFloat64 (in category 'inline primitive generated code') -----
- lowcodePrimitivePerformCallFloat64
- 	<option: #LowcodeVM>	"Lowcode instruction generator"
- 	| result function |
- 	<var: #result type: #'double' >
- 	function := extA.
- 
- 	result := self lowcodeCalloutFloat64Result: (self cCoerce: function to: #'char*').
- 
- 	self internalPushFloat64: result.
- 	extA := 0.
- 
- !

Item was removed:
- ----- Method: StackInterpreter>>lowcodePrimitivePerformCallIndirectFloat32 (in category 'inline primitive generated code') -----
- lowcodePrimitivePerformCallIndirectFloat32
- 	<option: #LowcodeVM>	"Lowcode instruction generator"
- 	| result function |
- 	<var: #result type: #'float' >
- 	<var: #function type: #'char*' >
- 	function := self internalPopStackPointer.
- 
- 	result := self lowcodeCalloutFloat32Result: function.
- 
- 	self internalPushFloat32: result.
- 
- !

Item was removed:
- ----- Method: StackInterpreter>>lowcodePrimitivePerformCallIndirectFloat64 (in category 'inline primitive generated code') -----
- lowcodePrimitivePerformCallIndirectFloat64
- 	<option: #LowcodeVM>	"Lowcode instruction generator"
- 	| result function |
- 	<var: #result type: #'double' >
- 	<var: #function type: #'char*' >
- 	function := self internalPopStackPointer.
- 
- 	result := self lowcodeCalloutFloat64Result: function.
- 
- 	self internalPushFloat64: result.
- 
- !

Item was removed:
- ----- Method: StackInterpreter>>lowcodePrimitivePerformCallIndirectInt32 (in category 'inline primitive generated code') -----
- lowcodePrimitivePerformCallIndirectInt32
- 	<option: #LowcodeVM>	"Lowcode instruction generator"
- 	| result function |
- 	<var: #result type: #'sqInt' >
- 	<var: #function type: #'char*' >
- 	function := self internalPopStackPointer.
- 
- 	result := self lowcodeCalloutInt32Result: function.
- 
- 	self internalPushInt32: result.
- 
- !

Item was removed:
- ----- Method: StackInterpreter>>lowcodePrimitivePerformCallIndirectInt64 (in category 'inline primitive generated code') -----
- lowcodePrimitivePerformCallIndirectInt64
- 	<option: #LowcodeVM>	"Lowcode instruction generator"
- 	| result function |
- 	<var: #result type: #'sqLong' >
- 	<var: #function type: #'char*' >
- 	function := self internalPopStackPointer.
- 
- 	result := self lowcodeCalloutInt64Result: function.
- 
- 	self internalPushInt64: result.
- 
- !

Item was removed:
- ----- Method: StackInterpreter>>lowcodePrimitivePerformCallIndirectPointer (in category 'inline primitive generated code') -----
- lowcodePrimitivePerformCallIndirectPointer
- 	<option: #LowcodeVM>	"Lowcode instruction generator"
- 	| result function |
- 	<var: #result type: #'char*' >
- 	<var: #function type: #'char*' >
- 	function := self internalPopStackPointer.
- 
- 	result := self lowcodeCalloutPointerResult: function.
- 
- 	self internalPushPointer: result.
- 
- !

Item was removed:
- ----- Method: StackInterpreter>>lowcodePrimitivePerformCallIndirectStructure (in category 'inline primitive generated code') -----
- lowcodePrimitivePerformCallIndirectStructure
- 	<option: #LowcodeVM>	"Lowcode instruction generator"
- 	| resultPointer result function structureSize |
- 	<var: #resultPointer type: #'char*' >
- 	<var: #result type: #'char*' >
- 	<var: #function type: #'char*' >
- 	structureSize := extA.
- 	result := self internalPopStackPointer.
- 	function := self internalPopStackPointer.
- 
- 	resultPointer := self lowcodeCallout: function structureResult: result.
- 
- 	self internalPushPointer: resultPointer.
- 	extA := 0.
- 
- !

Item was removed:
- ----- Method: StackInterpreter>>lowcodePrimitivePerformCallIndirectVoid (in category 'inline primitive generated code') -----
- lowcodePrimitivePerformCallIndirectVoid
- 	<option: #LowcodeVM>	"Lowcode instruction generator"
- 	| function |
- 	<var: #function type: #'char*' >
- 	function := self internalPopStackPointer.
- 
- 	self lowcodeCalloutInt32Result: function.
- 
- 
- !

Item was removed:
- ----- Method: StackInterpreter>>lowcodePrimitivePerformCallInt32 (in category 'inline primitive generated code') -----
- lowcodePrimitivePerformCallInt32
- 	<option: #LowcodeVM>	"Lowcode instruction generator"
- 	| result function |
- 	<var: #result type: #'sqInt' >
- 	function := extA.
- 
- 	result := self lowcodeCalloutInt32Result: (self cCoerce: function to: #'char*').
- 
- 	self internalPushInt32: result.
- 	extA := 0.
- 
- !

Item was removed:
- ----- Method: StackInterpreter>>lowcodePrimitivePerformCallInt64 (in category 'inline primitive generated code') -----
- lowcodePrimitivePerformCallInt64
- 	<option: #LowcodeVM>	"Lowcode instruction generator"
- 	| result function |
- 	<var: #result type: #'sqLong' >
- 	function := extA.
- 
- 	result := self lowcodeCalloutInt64Result: (self cCoerce: function to: #'char*').
- 
- 	self internalPushInt64: result.
- 	extA := 0.
- 
- !

Item was removed:
- ----- Method: StackInterpreter>>lowcodePrimitivePerformCallPointer (in category 'inline primitive generated code') -----
- lowcodePrimitivePerformCallPointer
- 	<option: #LowcodeVM>	"Lowcode instruction generator"
- 	| result function |
- 	<var: #result type: #'char*' >
- 	function := extA.
- 
- 	result := self lowcodeCalloutPointerResult: (self cCoerce: function to: #'char*').
- 
- 	self internalPushPointer: result.
- 	extA := 0.
- 
- !

Item was removed:
- ----- Method: StackInterpreter>>lowcodePrimitivePerformCallStructure (in category 'inline primitive generated code') -----
- lowcodePrimitivePerformCallStructure
- 	<option: #LowcodeVM>	"Lowcode instruction generator"
- 	| resultPointer result function structureSize |
- 	<var: #resultPointer type: #'char*' >
- 	<var: #result type: #'char*' >
- 	function := extA.
- 	structureSize := extB.
- 	result := self internalPopStackPointer.
- 
- 	self internalPushShadowCallStackPointer: result.
- 	resultPointer := self lowcodeCalloutPointerResult: (self cCoerce: function to: #'char*').
- 
- 	self internalPushPointer: resultPointer.
- 	extA := 0.
- 	extB := 0.
- 	numExtB := 0.
- 
- !

Item was removed:
- ----- Method: StackInterpreter>>lowcodePrimitivePerformCallVoid (in category 'inline primitive generated code') -----
- lowcodePrimitivePerformCallVoid
- 	<option: #LowcodeVM>	"Lowcode instruction generator"
- 	| function |
- 	function := extA.
- 
- 	self lowcodeCalloutInt32Result: (self cCoerce: function to: #'char*').
- 
- 	extA := 0.
- 
- !

Item was added:
+ ----- Method: StackInterpreter>>lowcodePrimitivePerformCallout (in category 'inline primitive generated code') -----
+ lowcodePrimitivePerformCallout
+ 	<option: #LowcodeVM>	"Lowcode instruction generator"
+ 	| function |
+ 	function := extA.
+ 
+ 	self lowcodeDoCallout: (self cCoerce: function to: #'char*').
+ 
+ 	extA := 0.
+ 
+ !

Item was added:
+ ----- Method: StackInterpreter>>lowcodePrimitivePerformCalloutIndirect (in category 'inline primitive generated code') -----
+ lowcodePrimitivePerformCalloutIndirect
+ 	<option: #LowcodeVM>	"Lowcode instruction generator"
+ 	| function |
+ 	<var: #function type: #'char*' >
+ 	function := self internalPopStackPointer.
+ 
+ 	self lowcodeDoCallout: function.
+ 
+ 
+ !

Item was added:
+ ----- Method: StackInterpreter>>lowcodePrimitivePushCalloutResultFloat32 (in category 'inline primitive generated code') -----
+ lowcodePrimitivePushCalloutResultFloat32
+ 	<option: #LowcodeVM>	"Lowcode instruction generator"
+ 	| result |
+ 	<var: #result type: #'float' >
+ 
+ 	result := self lowcodeCalloutStateFetchResultFloat32: lowcodeCalloutState.
+ 
+ 	self internalPushFloat32: result.
+ 
+ !

Item was added:
+ ----- Method: StackInterpreter>>lowcodePrimitivePushCalloutResultFloat64 (in category 'inline primitive generated code') -----
+ lowcodePrimitivePushCalloutResultFloat64
+ 	<option: #LowcodeVM>	"Lowcode instruction generator"
+ 	| result |
+ 	<var: #result type: #'double' >
+ 
+ 	result := self lowcodeCalloutStateFetchResultFloat64: lowcodeCalloutState.
+ 
+ 	self internalPushFloat64: result.
+ 
+ !

Item was added:
+ ----- Method: StackInterpreter>>lowcodePrimitivePushCalloutResultInt32 (in category 'inline primitive generated code') -----
+ lowcodePrimitivePushCalloutResultInt32
+ 	<option: #LowcodeVM>	"Lowcode instruction generator"
+ 	| result |
+ 	<var: #result type: #'sqInt' >
+ 
+ 	result := self lowcodeCalloutStateFetchResultInt32: lowcodeCalloutState.
+ 
+ 	self internalPushInt32: result.
+ 
+ !

Item was added:
+ ----- Method: StackInterpreter>>lowcodePrimitivePushCalloutResultInt64 (in category 'inline primitive generated code') -----
+ lowcodePrimitivePushCalloutResultInt64
+ 	<option: #LowcodeVM>	"Lowcode instruction generator"
+ 	| result |
+ 	<var: #result type: #'sqLong' >
+ 
+ 	result := self lowcodeCalloutStateFetchResultInt64: lowcodeCalloutState.
+ 
+ 	self internalPushInt64: result.
+ 
+ !

Item was added:
+ ----- Method: StackInterpreter>>lowcodePrimitivePushCalloutResultPointer (in category 'inline primitive generated code') -----
+ lowcodePrimitivePushCalloutResultPointer
+ 	<option: #LowcodeVM>	"Lowcode instruction generator"
+ 	| result |
+ 	<var: #result type: #'char*' >
+ 
+ 	result := self lowcodeCalloutStateFetchResultPointer: lowcodeCalloutState.
+ 
+ 	self internalPushPointer: result.
+ 
+ !

Item was changed:
  ----- Method: StackInterpreter>>lowcodeUnaryInlinePrimitive3: (in category 'inline primitive dispatch generated code') -----
  lowcodeUnaryInlinePrimitive3: prim
  	<option: #LowcodeVM>	"Lowcode instruction interpreter dispatch"
  	prim
  		caseOf: {
  			[120]	-> [ ^ self lowcodePrimitiveLoadObjectField ].
  			[121]	-> [ ^ self lowcodePrimitiveLoadPointerFromMemory ].
  			[122]	-> [ ^ self lowcodePrimitiveLoadUInt16FromMemory ].
  			[123]	-> [ ^ self lowcodePrimitiveLoadUInt32FromMemory ].
  			[124]	-> [ ^ self lowcodePrimitiveLoadUInt64FromMemory ].
  			[125]	-> [ ^ self lowcodePrimitiveLoadUInt8FromMemory ].
  			[126]	-> [ ^ self lowcodePrimitiveLocalFrameSize ].
  			[127]	-> [ ^ self lowcodePrimitiveLockRegisters ].
  			[128]	-> [ ^ self lowcodePrimitiveLockVM ].
  			[129]	-> [ ^ self lowcodePrimitiveMalloc32 ].
  			[130]	-> [ ^ self lowcodePrimitiveMalloc64 ].
  			[131]	-> [ ^ self lowcodePrimitiveMemcpy32 ].
  			[132]	-> [ ^ self lowcodePrimitiveMemcpy64 ].
  			[133]	-> [ ^ self lowcodePrimitiveMemcpyFixed ].
  			[134]	-> [ ^ self lowcodePrimitiveMoveFloat32ToPhysical ].
  			[135]	-> [ ^ self lowcodePrimitiveMoveFloat64ToPhysical ].
  			[136]	-> [ ^ self lowcodePrimitiveMoveInt32ToPhysical ].
  			[137]	-> [ ^ self lowcodePrimitiveMoveInt64ToPhysical ].
  			[138]	-> [ ^ self lowcodePrimitiveMovePointerToPhysical ].
  			[139]	-> [ ^ self lowcodePrimitiveMul32 ].
  			[140]	-> [ ^ self lowcodePrimitiveMul64 ].
  			[141]	-> [ ^ self lowcodePrimitiveNeg32 ].
  			[142]	-> [ ^ self lowcodePrimitiveNeg64 ].
  			[143]	-> [ ^ self lowcodePrimitiveNot32 ].
  			[144]	-> [ ^ self lowcodePrimitiveNot64 ].
  			[145]	-> [ ^ self lowcodePrimitiveOr32 ].
  			[146]	-> [ ^ self lowcodePrimitiveOr64 ].
+ 			[147]	-> [ ^ self lowcodePrimitivePerformCallout ].
+ 			[148]	-> [ ^ self lowcodePrimitivePerformCalloutIndirect ].
+ 			[149]	-> [ ^ self lowcodePrimitivePushCalloutResultFloat32 ].
+ 			[150]	-> [ ^ self lowcodePrimitivePushCalloutResultFloat64 ].
+ 			[151]	-> [ ^ self lowcodePrimitivePushCalloutResultInt32 ].
+ 			[152]	-> [ ^ self lowcodePrimitivePushCalloutResultInt64 ].
+ 			[153]	-> [ ^ self lowcodePrimitivePushCalloutResultPointer ].
- 			[147]	-> [ ^ self lowcodePrimitivePerformCallFloat32 ].
- 			[148]	-> [ ^ self lowcodePrimitivePerformCallFloat64 ].
- 			[149]	-> [ ^ self lowcodePrimitivePerformCallIndirectFloat32 ].
- 			[150]	-> [ ^ self lowcodePrimitivePerformCallIndirectFloat64 ].
- 			[151]	-> [ ^ self lowcodePrimitivePerformCallIndirectInt32 ].
- 			[152]	-> [ ^ self lowcodePrimitivePerformCallIndirectInt64 ].
- 			[153]	-> [ ^ self lowcodePrimitivePerformCallIndirectPointer ].
- 			[154]	-> [ ^ self lowcodePrimitivePerformCallIndirectStructure ].
- 			[155]	-> [ ^ self lowcodePrimitivePerformCallIndirectVoid ].
- 			[156]	-> [ ^ self lowcodePrimitivePerformCallInt32 ].
- 			[157]	-> [ ^ self lowcodePrimitivePerformCallInt64 ].
- 			[158]	-> [ ^ self lowcodePrimitivePerformCallPointer ].
- 			[159]	-> [ ^ self lowcodePrimitivePerformCallStructure ].
- 			[160]	-> [ ^ self lowcodePrimitivePerformCallVoid ].
  			[161]	-> [ ^ self lowcodePrimitivePlaftormCode ].
  			[162]	-> [ ^ self lowcodePrimitivePointerAddConstantOffset ].
  			[163]	-> [ ^ self lowcodePrimitivePointerAddOffset32 ].
  			[164]	-> [ ^ self lowcodePrimitivePointerAddOffset64 ].
  			[165]	-> [ ^ self lowcodePrimitivePointerEqual ].
  			[166]	-> [ ^ self lowcodePrimitivePointerNotEqual ].
  			[167]	-> [ ^ self lowcodePrimitivePointerToInt32 ].
  			[168]	-> [ ^ self lowcodePrimitivePointerToInt64 ].
  			[169]	-> [ ^ self lowcodePrimitivePopFloat32 ].
  			[170]	-> [ ^ self lowcodePrimitivePopFloat64 ].
  			[171]	-> [ ^ self lowcodePrimitivePopInt32 ].
  			[172]	-> [ ^ self lowcodePrimitivePopInt64 ].
  			[173]	-> [ ^ self lowcodePrimitivePopMultipleNative ].
  			[174]	-> [ ^ self lowcodePrimitivePopPointer ].
  			[175]	-> [ ^ self lowcodePrimitivePushConstantUInt32 ].
  			[176]	-> [ ^ self lowcodePrimitivePushConstantUInt64 ].
  			[177]	-> [ ^ self lowcodePrimitivePushNullPointer ].
  			[178]	-> [ ^ self lowcodePrimitivePushOne32 ].
  			[179]	-> [ ^ self lowcodePrimitivePushOne64 ].
+ 			[180]	-> [ ^ self lowcodePrimitivePushOneFloat32 ].
+ 			[181]	-> [ ^ self lowcodePrimitivePushOneFloat64 ].
+ 			[182]	-> [ ^ self lowcodePrimitivePushPhysicalFloat32 ].
+ 			[183]	-> [ ^ self lowcodePrimitivePushPhysicalFloat64 ].
+ 			[184]	-> [ ^ self lowcodePrimitivePushPhysicalInt32 ].
+ 			[185]	-> [ ^ self lowcodePrimitivePushPhysicalInt64 ].
+ 			[186]	-> [ ^ self lowcodePrimitivePushPhysicalPointer ].
  		}
  		otherwise: [ ^ self lowcodeUnaryInlinePrimitive4: prim ].
  	
  
  !

Item was changed:
  ----- Method: StackInterpreter>>lowcodeUnaryInlinePrimitive4: (in category 'inline primitive dispatch generated code') -----
  lowcodeUnaryInlinePrimitive4: prim
  	<option: #LowcodeVM>	"Lowcode instruction interpreter dispatch"
  	prim
  		caseOf: {
- 			[180]	-> [ ^ self lowcodePrimitivePushOneFloat32 ].
- 			[181]	-> [ ^ self lowcodePrimitivePushOneFloat64 ].
- 			[182]	-> [ ^ self lowcodePrimitivePushPhysicalFloat32 ].
- 			[183]	-> [ ^ self lowcodePrimitivePushPhysicalFloat64 ].
- 			[184]	-> [ ^ self lowcodePrimitivePushPhysicalInt32 ].
- 			[185]	-> [ ^ self lowcodePrimitivePushPhysicalInt64 ].
- 			[186]	-> [ ^ self lowcodePrimitivePushPhysicalPointer ].
  			[187]	-> [ ^ self lowcodePrimitivePushSessionIdentifier ].
  			[188]	-> [ ^ self lowcodePrimitivePushZero32 ].
  			[189]	-> [ ^ self lowcodePrimitivePushZero64 ].
  			[190]	-> [ ^ self lowcodePrimitivePushZeroFloat32 ].
  			[191]	-> [ ^ self lowcodePrimitivePushZeroFloat64 ].
  			[192]	-> [ ^ self lowcodePrimitiveRem32 ].
  			[193]	-> [ ^ self lowcodePrimitiveRem64 ].
  			[194]	-> [ ^ self lowcodePrimitiveRightShift32 ].
  			[195]	-> [ ^ self lowcodePrimitiveRightShift64 ].
  			[196]	-> [ ^ self lowcodePrimitiveSignExtend32From16 ].
  			[197]	-> [ ^ self lowcodePrimitiveSignExtend32From8 ].
  			[198]	-> [ ^ self lowcodePrimitiveSignExtend64From16 ].
  			[199]	-> [ ^ self lowcodePrimitiveSignExtend64From32 ].
  			[200]	-> [ ^ self lowcodePrimitiveSignExtend64From8 ].
  			[201]	-> [ ^ self lowcodePrimitiveStoreFloat32ToMemory ].
  			[202]	-> [ ^ self lowcodePrimitiveStoreFloat64ToMemory ].
  			[203]	-> [ ^ self lowcodePrimitiveStoreInt16ToMemory ].
  			[204]	-> [ ^ self lowcodePrimitiveStoreInt32ToMemory ].
  			[205]	-> [ ^ self lowcodePrimitiveStoreInt64ToMemory ].
  			[206]	-> [ ^ self lowcodePrimitiveStoreInt8ToMemory ].
  			[207]	-> [ ^ self lowcodePrimitiveStoreLocalFloat32 ].
  			[208]	-> [ ^ self lowcodePrimitiveStoreLocalFloat64 ].
  			[209]	-> [ ^ self lowcodePrimitiveStoreLocalInt16 ].
  			[210]	-> [ ^ self lowcodePrimitiveStoreLocalInt32 ].
  			[211]	-> [ ^ self lowcodePrimitiveStoreLocalInt64 ].
  			[212]	-> [ ^ self lowcodePrimitiveStoreLocalInt8 ].
  			[213]	-> [ ^ self lowcodePrimitiveStoreLocalPointer ].
  			[214]	-> [ ^ self lowcodePrimitiveStorePointerToMemory ].
  			[215]	-> [ ^ self lowcodePrimitiveSub32 ].
  			[216]	-> [ ^ self lowcodePrimitiveSub64 ].
  			[217]	-> [ ^ self lowcodePrimitiveTruncate32To16 ].
  			[218]	-> [ ^ self lowcodePrimitiveTruncate32To8 ].
  			[219]	-> [ ^ self lowcodePrimitiveTruncate64To16 ].
  			[220]	-> [ ^ self lowcodePrimitiveTruncate64To32 ].
  			[221]	-> [ ^ self lowcodePrimitiveTruncate64To8 ].
  			[222]	-> [ ^ self lowcodePrimitiveUdiv32 ].
  			[223]	-> [ ^ self lowcodePrimitiveUdiv64 ].
  			[224]	-> [ ^ self lowcodePrimitiveUint32Great ].
  			[225]	-> [ ^ self lowcodePrimitiveUint32GreatEqual ].
  			[226]	-> [ ^ self lowcodePrimitiveUint32Less ].
  			[227]	-> [ ^ self lowcodePrimitiveUint32LessEqual ].
  			[228]	-> [ ^ self lowcodePrimitiveUint32ToFloat32 ].
  			[229]	-> [ ^ self lowcodePrimitiveUint32ToFloat64 ].
  			[230]	-> [ ^ self lowcodePrimitiveUint64Great ].
  			[231]	-> [ ^ self lowcodePrimitiveUint64GreatEqual ].
  			[232]	-> [ ^ self lowcodePrimitiveUint64Less ].
  			[233]	-> [ ^ self lowcodePrimitiveUint64LessEqual ].
  			[234]	-> [ ^ self lowcodePrimitiveUint64ToFloat32 ].
  			[235]	-> [ ^ self lowcodePrimitiveUint64ToFloat64 ].
  			[236]	-> [ ^ self lowcodePrimitiveUmul32 ].
  			[237]	-> [ ^ self lowcodePrimitiveUmul64 ].
  			[238]	-> [ ^ self lowcodePrimitiveUnlockRegisters ].
  			[239]	-> [ ^ self lowcodePrimitiveUnlockVM ].
+ 			[240]	-> [ ^ self lowcodePrimitiveUrem32 ].
+ 			[241]	-> [ ^ self lowcodePrimitiveUrem64 ].
+ 			[242]	-> [ ^ self lowcodePrimitiveXor32 ].
+ 			[243]	-> [ ^ self lowcodePrimitiveXor64 ].
+ 			[244]	-> [ ^ self lowcodePrimitiveZeroExtend32From16 ].
+ 			[245]	-> [ ^ self lowcodePrimitiveZeroExtend32From8 ].
+ 			[246]	-> [ ^ self lowcodePrimitiveZeroExtend64From16 ].
  		}
  		otherwise: [ ^ self lowcodeUnaryInlinePrimitive5: prim ].
  	
  
  !

Item was changed:
  ----- Method: StackInterpreter>>lowcodeUnaryInlinePrimitive5: (in category 'inline primitive dispatch generated code') -----
  lowcodeUnaryInlinePrimitive5: prim
  	<option: #LowcodeVM>	"Lowcode instruction interpreter dispatch"
  	prim
  		caseOf: {
- 			[240]	-> [ ^ self lowcodePrimitiveUrem32 ].
- 			[241]	-> [ ^ self lowcodePrimitiveUrem64 ].
- 			[242]	-> [ ^ self lowcodePrimitiveXor32 ].
- 			[243]	-> [ ^ self lowcodePrimitiveXor64 ].
- 			[244]	-> [ ^ self lowcodePrimitiveZeroExtend32From16 ].
- 			[245]	-> [ ^ self lowcodePrimitiveZeroExtend32From8 ].
- 			[246]	-> [ ^ self lowcodePrimitiveZeroExtend64From16 ].
  			[247]	-> [ ^ self lowcodePrimitiveZeroExtend64From32 ].
  			[248]	-> [ ^ self lowcodePrimitiveZeroExtend64From8 ].
  		}
  		otherwise: [
  			localIP := localIP - 3.
  			^self respondToUnknownBytecode
  		].
  	
  
  !

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genLowcodePerformCallFloat32 (in category 'inline primitive generators generated code') -----
  genLowcodePerformCallFloat32
  	<option: #LowcodeVM>	"Lowcode instruction generator"
  
  	self callSwitchToCStack.
  	self MoveCw: extA R: TempReg.
  	self CallRT: ceFFICalloutTrampoline.
+ 	self annotateBytecode: self Label.
  	backEnd cFloatResultToRs: DPFPReg0.
  	self ssPushNativeRegisterSingleFloat: DPFPReg0.
  	extA := 0.
  
  	^ 0
  
  !

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genLowcodePerformCallFloat64 (in category 'inline primitive generators generated code') -----
  genLowcodePerformCallFloat64
  	<option: #LowcodeVM>	"Lowcode instruction generator"
  
  	self callSwitchToCStack.
  	self MoveCw: extA R: TempReg.
  	self CallRT: ceFFICalloutTrampoline.
+ 	self annotateBytecode: self Label.
  	backEnd cFloatResultToRd: DPFPReg0.
  	self ssPushNativeRegisterDoubleFloat: DPFPReg0.
  	extA := 0.
  
  	^ 0
  
  !

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genLowcodePerformCallIndirectFloat32 (in category 'inline primitive generators generated code') -----
  genLowcodePerformCallIndirectFloat32
  	<option: #LowcodeVM>	"Lowcode instruction generator"
  
  	self ssNativeTop nativeStackPopToReg: TempReg.
  	self ssNativePop: 1.
  	self callSwitchToCStack.
  	self CallRT: ceFFICalloutTrampoline.
+ 	self annotateBytecode: self Label.
  	backEnd cFloatResultToRs: DPFPReg0.
  	self ssPushNativeRegisterSingleFloat: DPFPReg0.
  
  	^ 0
  
  !

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genLowcodePerformCallIndirectFloat64 (in category 'inline primitive generators generated code') -----
  genLowcodePerformCallIndirectFloat64
  	<option: #LowcodeVM>	"Lowcode instruction generator"
  
  	self ssNativeTop nativeStackPopToReg: TempReg.
  	self ssNativePop: 1.
  	self callSwitchToCStack.
  	self CallRT: ceFFICalloutTrampoline.
+ 	self annotateBytecode: self Label.
  	backEnd cFloatResultToRd: DPFPReg0.
  	self ssPushNativeRegisterDoubleFloat: DPFPReg0.
  
  	^ 0
  
  !

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genLowcodePerformCallIndirectInt32 (in category 'inline primitive generators generated code') -----
  genLowcodePerformCallIndirectInt32
  	<option: #LowcodeVM>	"Lowcode instruction generator"
  
  	self ssNativeTop nativeStackPopToReg: TempReg.
  	self ssNativePop: 1.
  	self callSwitchToCStack.
  	self CallRT: ceFFICalloutTrampoline.
+ 	self annotateBytecode: self Label.
  	self MoveR: backEnd cResultRegister R: ReceiverResultReg.
  	self ssPushNativeRegister: ReceiverResultReg.
  
  	^ 0
  
  !

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genLowcodePerformCallIndirectInt64 (in category 'inline primitive generators generated code') -----
  genLowcodePerformCallIndirectInt64
  	<option: #LowcodeVM>	"Lowcode instruction generator"
  
  	self ssNativeTop nativeStackPopToReg: TempReg.
  	self ssNativePop: 1.
  	self callSwitchToCStack.
  	self CallRT: ceFFICalloutTrampoline.
+ 	self annotateBytecode: self Label.
  	BytesPerWord = 4 ifTrue: [
  	self MoveR: backEnd cResultRegisterLow R: ReceiverResultReg.
  	self MoveR: backEnd cResultRegisterHigh R: Arg0Reg.
  	self ssPushNativeRegister: ReceiverResultReg secondRegister: Arg0Reg.
  	] ifFalse: [
  	self MoveR: backEnd cResultRegister R: ReceiverResultReg.
  	self ssPushNativeRegister: ReceiverResultReg.
  	].
  
  	^ 0
  
  !

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genLowcodePerformCallIndirectPointer (in category 'inline primitive generators generated code') -----
  genLowcodePerformCallIndirectPointer
  	<option: #LowcodeVM>	"Lowcode instruction generator"
  
  	self ssNativeTop nativeStackPopToReg: TempReg.
  	self ssNativePop: 1.
  	self callSwitchToCStack.
  	self CallRT: ceFFICalloutTrampoline.
+ 	self annotateBytecode: self Label.
  	self MoveR: backEnd cResultRegister R: ReceiverResultReg.
  	self ssPushNativeRegister: ReceiverResultReg.
  
  	^ 0
  
  !

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genLowcodePerformCallIndirectStructure (in category 'inline primitive generators generated code') -----
  genLowcodePerformCallIndirectStructure
  	<option: #LowcodeVM>	"Lowcode instruction generator"
  
  	"Push the result space"
  	self ssNativeTop nativeStackPopToReg: TempReg.
  	self ssNativePop: 1.
  	self PushR: TempReg.
  	"Fetch the function pointer"
  	self ssNativeTop nativeStackPopToReg: TempReg.
  	self ssNativePop: 1.
  	"Call the function"
  	self callSwitchToCStack.
  	self CallRT: ceFFICalloutTrampoline.
+ 	self annotateBytecode: self Label.
  	"Fetch the result"
  	self MoveR: backEnd cResultRegister R: ReceiverResultReg.
  	self ssPushNativeRegister: ReceiverResultReg.
  	extA := 0.
  
  	^ 0
  
  !

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genLowcodePerformCallIndirectVoid (in category 'inline primitive generators generated code') -----
  genLowcodePerformCallIndirectVoid
  	<option: #LowcodeVM>	"Lowcode instruction generator"
  
  	self ssNativeTop nativeStackPopToReg: TempReg.
  	self ssNativePop: 1.
  	self callSwitchToCStack.
  	self CallRT: ceFFICalloutTrampoline.
+ 	self annotateBytecode: self Label.
  
  	^ 0
  
  !

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genLowcodePerformCallInt32 (in category 'inline primitive generators generated code') -----
  genLowcodePerformCallInt32
  	<option: #LowcodeVM>	"Lowcode instruction generator"
  
  	self callSwitchToCStack.
  	self MoveCw: extA R: TempReg.
  	self CallRT: ceFFICalloutTrampoline.
+ 	self annotateBytecode: self Label.
  	self MoveR: backEnd cResultRegister R: ReceiverResultReg.
  	self ssPushNativeRegister: ReceiverResultReg.
  	extA := 0.
  
  	^ 0
  
  !

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genLowcodePerformCallInt64 (in category 'inline primitive generators generated code') -----
  genLowcodePerformCallInt64
  	<option: #LowcodeVM>	"Lowcode instruction generator"
  
  	self callSwitchToCStack.
  	self MoveCw: extA R: TempReg.
  	self CallRT: ceFFICalloutTrampoline.
+ 	self annotateBytecode: self Label.
  	BytesPerWord = 4 ifTrue: [
  	self MoveR: backEnd cResultRegisterLow R: ReceiverResultReg.
  	self MoveR: backEnd cResultRegisterHigh R: Arg0Reg.
  	self ssPushNativeRegister: ReceiverResultReg secondRegister: Arg0Reg.
  	] ifFalse: [
  	self MoveR: backEnd cResultRegister R: ReceiverResultReg.
  	self ssPushNativeRegister: ReceiverResultReg.
  	].
  	extA := 0.
  
  	^ 0
  
  !

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genLowcodePerformCallPointer (in category 'inline primitive generators generated code') -----
  genLowcodePerformCallPointer
  	<option: #LowcodeVM>	"Lowcode instruction generator"
  
  	self callSwitchToCStack.
  	self MoveCw: extA R: TempReg.
  	self CallRT: ceFFICalloutTrampoline.
+ 	self annotateBytecode: self Label.
  	self MoveR: backEnd cResultRegister R: ReceiverResultReg.
  	self ssPushNativeRegister: ReceiverResultReg.
  	extA := 0.
  
  	^ 0
  
  !

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genLowcodePerformCallStructure (in category 'inline primitive generators generated code') -----
  genLowcodePerformCallStructure
  	<option: #LowcodeVM>	"Lowcode instruction generator"
  
  	"Push the result space"
  	self ssNativeTop nativeStackPopToReg: TempReg.
  	self ssNativePop: 1.
  	self PushR: TempReg.
  	"Call the function"
  	self callSwitchToCStack.
  	self MoveCw: extA R: TempReg.
  	self CallRT: ceFFICalloutTrampoline.
+ 	self annotateBytecode: self Label.
  	"Fetch the result"
  	self MoveR: backEnd cResultRegister R: ReceiverResultReg.
  	self ssPushNativeRegister: ReceiverResultReg.
  	extA := 0.
  	extB := 0.
  	numExtB := 0.
  
  	^ 0
  
  !

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genLowcodePerformCallVoid (in category 'inline primitive generators generated code') -----
  genLowcodePerformCallVoid
  	<option: #LowcodeVM>	"Lowcode instruction generator"
  
  	self callSwitchToCStack.
  	self MoveCw: extA R: TempReg.
  	self CallRT: ceFFICalloutTrampoline.
+ 	self annotateBytecode: self Label.
  	extA := 0.
  
  	^ 0
  
  !

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>genLowcodePerformCallout (in category 'inline primitive generators generated code') -----
+ genLowcodePerformCallout
+ 	<option: #LowcodeVM>	"Lowcode instruction generator"
+ 
+ 	self callSwitchToCStack.
+ 	self MoveCw: extA R: TempReg.
+ 	self CallRT: ceFFICalloutTrampoline.
+ 	self annotateBytecode: self Label.
+ 	extA := 0.
+ 
+ 	^ 0
+ 
+ !

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>genLowcodePerformCalloutIndirect (in category 'inline primitive generators generated code') -----
+ genLowcodePerformCalloutIndirect
+ 	<option: #LowcodeVM>	"Lowcode instruction generator"
+ 
+ 	self ssNativeTop nativeStackPopToReg: TempReg.
+ 	self ssNativePop: 1.
+ 	self callSwitchToCStack.
+ 	self CallRT: ceFFICalloutTrampoline.
+ 	self annotateBytecode: self Label.
+ 
+ 	^ 0
+ 
+ !

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>genLowcodePushCalloutResultFloat32 (in category 'inline primitive generators generated code') -----
+ genLowcodePushCalloutResultFloat32
+ 	<option: #LowcodeVM>	"Lowcode instruction generator"
+ 
+ 	backEnd cFloatResultToRs: DPFPReg0.
+ 	self ssPushNativeRegisterSingleFloat: DPFPReg0.
+ 
+ 	^ 0
+ 
+ !

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>genLowcodePushCalloutResultFloat64 (in category 'inline primitive generators generated code') -----
+ genLowcodePushCalloutResultFloat64
+ 	<option: #LowcodeVM>	"Lowcode instruction generator"
+ 
+ 	backEnd cFloatResultToRd: DPFPReg0.
+ 	self ssPushNativeRegisterDoubleFloat: DPFPReg0.
+ 
+ 	^ 0
+ 
+ !

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>genLowcodePushCalloutResultInt32 (in category 'inline primitive generators generated code') -----
+ genLowcodePushCalloutResultInt32
+ 	<option: #LowcodeVM>	"Lowcode instruction generator"
+ 
+ 	self MoveR: backEnd cResultRegister R: ReceiverResultReg.
+ 	self ssPushNativeRegister: ReceiverResultReg.
+ 
+ 	^ 0
+ 
+ !

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>genLowcodePushCalloutResultInt64 (in category 'inline primitive generators generated code') -----
+ genLowcodePushCalloutResultInt64
+ 	<option: #LowcodeVM>	"Lowcode instruction generator"
+ 
+ 	BytesPerWord = 4 ifTrue: [
+ 	self MoveR: backEnd cResultRegisterLow R: ReceiverResultReg.
+ 	self MoveR: backEnd cResultRegisterHigh R: Arg0Reg.
+ 	self ssPushNativeRegister: ReceiverResultReg secondRegister: Arg0Reg.
+ 	] ifFalse: [
+ 	self MoveR: backEnd cResultRegister R: ReceiverResultReg.
+ 	self ssPushNativeRegister: ReceiverResultReg.
+ 	].
+ 
+ 	^ 0
+ 
+ !

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>genLowcodePushCalloutResultPointer (in category 'inline primitive generators generated code') -----
+ genLowcodePushCalloutResultPointer
+ 	<option: #LowcodeVM>	"Lowcode instruction generator"
+ 
+ 	self MoveR: backEnd cResultRegister R: ReceiverResultReg.
+ 	self ssPushNativeRegister: ReceiverResultReg.
+ 
+ 	^ 0
+ 
+ !

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genLowcodeUnaryInlinePrimitive3: (in category 'inline primitive generators dispatch generated code') -----
  genLowcodeUnaryInlinePrimitive3: prim
  	<option: #LowcodeVM>	"Lowcode instruction generator dispatch"
  	prim
  		caseOf: {
  			[120]	-> [ ^ self genLowcodeLoadObjectField ].
  			[121]	-> [ ^ self genLowcodeLoadPointerFromMemory ].
  			[122]	-> [ ^ self genLowcodeLoadUInt16FromMemory ].
  			[123]	-> [ ^ self genLowcodeLoadUInt32FromMemory ].
  			[124]	-> [ ^ self genLowcodeLoadUInt64FromMemory ].
  			[125]	-> [ ^ self genLowcodeLoadUInt8FromMemory ].
  			[126]	-> [ ^ self genLowcodeLocalFrameSize ].
  			[127]	-> [ ^ self genLowcodeLockRegisters ].
  			[128]	-> [ ^ self genLowcodeLockVM ].
  			[129]	-> [ ^ self genLowcodeMalloc32 ].
  			[130]	-> [ ^ self genLowcodeMalloc64 ].
  			[131]	-> [ ^ self genLowcodeMemcpy32 ].
  			[132]	-> [ ^ self genLowcodeMemcpy64 ].
  			[133]	-> [ ^ self genLowcodeMemcpyFixed ].
  			[134]	-> [ ^ self genLowcodeMoveFloat32ToPhysical ].
  			[135]	-> [ ^ self genLowcodeMoveFloat64ToPhysical ].
  			[136]	-> [ ^ self genLowcodeMoveInt32ToPhysical ].
  			[137]	-> [ ^ self genLowcodeMoveInt64ToPhysical ].
  			[138]	-> [ ^ self genLowcodeMovePointerToPhysical ].
  			[139]	-> [ ^ self genLowcodeMul32 ].
  			[140]	-> [ ^ self genLowcodeMul64 ].
  			[141]	-> [ ^ self genLowcodeNeg32 ].
  			[142]	-> [ ^ self genLowcodeNeg64 ].
  			[143]	-> [ ^ self genLowcodeNot32 ].
  			[144]	-> [ ^ self genLowcodeNot64 ].
  			[145]	-> [ ^ self genLowcodeOr32 ].
  			[146]	-> [ ^ self genLowcodeOr64 ].
+ 			[147]	-> [ ^ self genLowcodePerformCallout ].
+ 			[148]	-> [ ^ self genLowcodePerformCalloutIndirect ].
+ 			[149]	-> [ ^ self genLowcodePushCalloutResultFloat32 ].
+ 			[150]	-> [ ^ self genLowcodePushCalloutResultFloat64 ].
+ 			[151]	-> [ ^ self genLowcodePushCalloutResultInt32 ].
+ 			[152]	-> [ ^ self genLowcodePushCalloutResultInt64 ].
+ 			[153]	-> [ ^ self genLowcodePushCalloutResultPointer ].
- 			[147]	-> [ ^ self genLowcodePerformCallFloat32 ].
- 			[148]	-> [ ^ self genLowcodePerformCallFloat64 ].
- 			[149]	-> [ ^ self genLowcodePerformCallIndirectFloat32 ].
- 			[150]	-> [ ^ self genLowcodePerformCallIndirectFloat64 ].
- 			[151]	-> [ ^ self genLowcodePerformCallIndirectInt32 ].
- 			[152]	-> [ ^ self genLowcodePerformCallIndirectInt64 ].
- 			[153]	-> [ ^ self genLowcodePerformCallIndirectPointer ].
- 			[154]	-> [ ^ self genLowcodePerformCallIndirectStructure ].
- 			[155]	-> [ ^ self genLowcodePerformCallIndirectVoid ].
- 			[156]	-> [ ^ self genLowcodePerformCallInt32 ].
- 			[157]	-> [ ^ self genLowcodePerformCallInt64 ].
- 			[158]	-> [ ^ self genLowcodePerformCallPointer ].
- 			[159]	-> [ ^ self genLowcodePerformCallStructure ].
- 			[160]	-> [ ^ self genLowcodePerformCallVoid ].
  			[161]	-> [ ^ self genLowcodePlaftormCode ].
  			[162]	-> [ ^ self genLowcodePointerAddConstantOffset ].
  			[163]	-> [ ^ self genLowcodePointerAddOffset32 ].
  			[164]	-> [ ^ self genLowcodePointerAddOffset64 ].
  			[165]	-> [ ^ self genLowcodePointerEqual ].
  			[166]	-> [ ^ self genLowcodePointerNotEqual ].
  			[167]	-> [ ^ self genLowcodePointerToInt32 ].
  			[168]	-> [ ^ self genLowcodePointerToInt64 ].
  			[169]	-> [ ^ self genLowcodePopFloat32 ].
  			[170]	-> [ ^ self genLowcodePopFloat64 ].
  			[171]	-> [ ^ self genLowcodePopInt32 ].
  			[172]	-> [ ^ self genLowcodePopInt64 ].
  			[173]	-> [ ^ self genLowcodePopMultipleNative ].
  			[174]	-> [ ^ self genLowcodePopPointer ].
  			[175]	-> [ ^ self genLowcodePushConstantUInt32 ].
  			[176]	-> [ ^ self genLowcodePushConstantUInt64 ].
  			[177]	-> [ ^ self genLowcodePushNullPointer ].
  			[178]	-> [ ^ self genLowcodePushOne32 ].
  			[179]	-> [ ^ self genLowcodePushOne64 ].
+ 			[180]	-> [ ^ self genLowcodePushOneFloat32 ].
+ 			[181]	-> [ ^ self genLowcodePushOneFloat64 ].
+ 			[182]	-> [ ^ self genLowcodePushPhysicalFloat32 ].
+ 			[183]	-> [ ^ self genLowcodePushPhysicalFloat64 ].
+ 			[184]	-> [ ^ self genLowcodePushPhysicalInt32 ].
+ 			[185]	-> [ ^ self genLowcodePushPhysicalInt64 ].
+ 			[186]	-> [ ^ self genLowcodePushPhysicalPointer ].
  		}
  		otherwise: [ ^ self genLowcodeUnaryInlinePrimitive4: prim ].
  	^ 0
  
  !

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genLowcodeUnaryInlinePrimitive4: (in category 'inline primitive generators dispatch generated code') -----
  genLowcodeUnaryInlinePrimitive4: prim
  	<option: #LowcodeVM>	"Lowcode instruction generator dispatch"
  	prim
  		caseOf: {
- 			[180]	-> [ ^ self genLowcodePushOneFloat32 ].
- 			[181]	-> [ ^ self genLowcodePushOneFloat64 ].
- 			[182]	-> [ ^ self genLowcodePushPhysicalFloat32 ].
- 			[183]	-> [ ^ self genLowcodePushPhysicalFloat64 ].
- 			[184]	-> [ ^ self genLowcodePushPhysicalInt32 ].
- 			[185]	-> [ ^ self genLowcodePushPhysicalInt64 ].
- 			[186]	-> [ ^ self genLowcodePushPhysicalPointer ].
  			[187]	-> [ ^ self genLowcodePushSessionIdentifier ].
  			[188]	-> [ ^ self genLowcodePushZero32 ].
  			[189]	-> [ ^ self genLowcodePushZero64 ].
  			[190]	-> [ ^ self genLowcodePushZeroFloat32 ].
  			[191]	-> [ ^ self genLowcodePushZeroFloat64 ].
  			[192]	-> [ ^ self genLowcodeRem32 ].
  			[193]	-> [ ^ self genLowcodeRem64 ].
  			[194]	-> [ ^ self genLowcodeRightShift32 ].
  			[195]	-> [ ^ self genLowcodeRightShift64 ].
  			[196]	-> [ ^ self genLowcodeSignExtend32From16 ].
  			[197]	-> [ ^ self genLowcodeSignExtend32From8 ].
  			[198]	-> [ ^ self genLowcodeSignExtend64From16 ].
  			[199]	-> [ ^ self genLowcodeSignExtend64From32 ].
  			[200]	-> [ ^ self genLowcodeSignExtend64From8 ].
  			[201]	-> [ ^ self genLowcodeStoreFloat32ToMemory ].
  			[202]	-> [ ^ self genLowcodeStoreFloat64ToMemory ].
  			[203]	-> [ ^ self genLowcodeStoreInt16ToMemory ].
  			[204]	-> [ ^ self genLowcodeStoreInt32ToMemory ].
  			[205]	-> [ ^ self genLowcodeStoreInt64ToMemory ].
  			[206]	-> [ ^ self genLowcodeStoreInt8ToMemory ].
  			[207]	-> [ ^ self genLowcodeStoreLocalFloat32 ].
  			[208]	-> [ ^ self genLowcodeStoreLocalFloat64 ].
  			[209]	-> [ ^ self genLowcodeStoreLocalInt16 ].
  			[210]	-> [ ^ self genLowcodeStoreLocalInt32 ].
  			[211]	-> [ ^ self genLowcodeStoreLocalInt64 ].
  			[212]	-> [ ^ self genLowcodeStoreLocalInt8 ].
  			[213]	-> [ ^ self genLowcodeStoreLocalPointer ].
  			[214]	-> [ ^ self genLowcodeStorePointerToMemory ].
  			[215]	-> [ ^ self genLowcodeSub32 ].
  			[216]	-> [ ^ self genLowcodeSub64 ].
  			[217]	-> [ ^ self genLowcodeTruncate32To16 ].
  			[218]	-> [ ^ self genLowcodeTruncate32To8 ].
  			[219]	-> [ ^ self genLowcodeTruncate64To16 ].
  			[220]	-> [ ^ self genLowcodeTruncate64To32 ].
  			[221]	-> [ ^ self genLowcodeTruncate64To8 ].
  			[222]	-> [ ^ self genLowcodeUdiv32 ].
  			[223]	-> [ ^ self genLowcodeUdiv64 ].
  			[224]	-> [ ^ self genLowcodeUint32Great ].
  			[225]	-> [ ^ self genLowcodeUint32GreatEqual ].
  			[226]	-> [ ^ self genLowcodeUint32Less ].
  			[227]	-> [ ^ self genLowcodeUint32LessEqual ].
  			[228]	-> [ ^ self genLowcodeUint32ToFloat32 ].
  			[229]	-> [ ^ self genLowcodeUint32ToFloat64 ].
  			[230]	-> [ ^ self genLowcodeUint64Great ].
  			[231]	-> [ ^ self genLowcodeUint64GreatEqual ].
  			[232]	-> [ ^ self genLowcodeUint64Less ].
  			[233]	-> [ ^ self genLowcodeUint64LessEqual ].
  			[234]	-> [ ^ self genLowcodeUint64ToFloat32 ].
  			[235]	-> [ ^ self genLowcodeUint64ToFloat64 ].
  			[236]	-> [ ^ self genLowcodeUmul32 ].
  			[237]	-> [ ^ self genLowcodeUmul64 ].
  			[238]	-> [ ^ self genLowcodeUnlockRegisters ].
  			[239]	-> [ ^ self genLowcodeUnlockVM ].
+ 			[240]	-> [ ^ self genLowcodeUrem32 ].
+ 			[241]	-> [ ^ self genLowcodeUrem64 ].
+ 			[242]	-> [ ^ self genLowcodeXor32 ].
+ 			[243]	-> [ ^ self genLowcodeXor64 ].
+ 			[244]	-> [ ^ self genLowcodeZeroExtend32From16 ].
+ 			[245]	-> [ ^ self genLowcodeZeroExtend32From8 ].
+ 			[246]	-> [ ^ self genLowcodeZeroExtend64From16 ].
  		}
  		otherwise: [ ^ self genLowcodeUnaryInlinePrimitive5: prim ].
  	^ 0
  
  !

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genLowcodeUnaryInlinePrimitive5: (in category 'inline primitive generators dispatch generated code') -----
  genLowcodeUnaryInlinePrimitive5: prim
  	<option: #LowcodeVM>	"Lowcode instruction generator dispatch"
  	prim
  		caseOf: {
- 			[240]	-> [ ^ self genLowcodeUrem32 ].
- 			[241]	-> [ ^ self genLowcodeUrem64 ].
- 			[242]	-> [ ^ self genLowcodeXor32 ].
- 			[243]	-> [ ^ self genLowcodeXor64 ].
- 			[244]	-> [ ^ self genLowcodeZeroExtend32From16 ].
- 			[245]	-> [ ^ self genLowcodeZeroExtend32From8 ].
- 			[246]	-> [ ^ self genLowcodeZeroExtend64From16 ].
  			[247]	-> [ ^ self genLowcodeZeroExtend64From32 ].
  			[248]	-> [ ^ self genLowcodeZeroExtend64From8 ].
  		}
  		otherwise: [ ^ EncounteredUnknownBytecode ].
  	^ 0
  
  !

Item was added:
+ ----- Method: VMMaker class>>generateAllSpurLowcodeConfigurations (in category 'configurations') -----
+ generateAllSpurLowcodeConfigurations
+ 	self generateSqueakSpurLowcodeCogVM;
+ 		generateSqueakSpurLowcodeStackVM;
+ 		generateSqueakSpurLowcodeCog64VM;
+ 		generateSqueakSpurLowcodeStack64VM!

Item was added:
+ ----- Method: VMMaker class>>generateSqueakSpurLowcodeCog64VM (in category 'configurations') -----
+ generateSqueakSpurLowcodeCog64VM
+ 	"No primitives since we can use those for the Cog VM"
+ 	^VMMaker
+ 		generate: CoInterpreter
+ 		and: StackToRegisterMappingCogit
+ 		with: #(ObjectMemory Spur64BitCoMemoryManager
+ 				SistaVM true
+         			LowcodeVM true
+ 				MULTIPLEBYTECODESETS true
+ 				bytecodeTableInitializer initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid)
+ 		to: (FileDirectory default pathFromURI: self sourceTree, '/spurlowcode64src')
+ 		platformDir: (FileDirectory default pathFromURI: self sourceTree, '/platforms')
+ 		including:#()!

Item was added:
+ ----- Method: VMMaker class>>generateSqueakSpurLowcodeStack64VM (in category 'configurations') -----
+ generateSqueakSpurLowcodeStack64VM
+ 	"No primitives since we can use those from the Cog VM"
+ 	^VMMaker
+ 		generate: StackInterpreter
+ 		with: #(ObjectMemory Spur64BitMemoryManager
+ 				SistaVM true
+         			LowcodeVM true
+ 				FailImbalancedPrimitives false
+ 				MULTIPLEBYTECODESETS true
+ 				bytecodeTableInitializer initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid)
+ 		to: (FileDirectory default pathFromURI: self sourceTree, '/spurlowcodestack64src')
+ 		platformDir: (FileDirectory default pathFromURI: self sourceTree, '/platforms')
+ 		including: #()!



More information about the Vm-dev mailing list