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

commits at source.squeak.org commits at source.squeak.org
Sat Nov 2 00:49:31 UTC 2013


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

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

Name: VMMaker.oscog-eem.492
Author: eem
Time: 1 November 2013, 3:18:11.586 pm
UUID: f0d31c8c-9e93-4d77-ae6e-4e853a7d0d38
Ancestors: VMMaker.oscog-eem.491

Cope with char, short et al as return types, promoting them to #sqInt
in harmonizeSignedAndUnsignedTypesIn:.

Remove several extraneous type decls for missing vars.
Fix conflicitng return types in dispatchConcretize by declaring it void.

Put commas between conflicting types in the report.

L:ine up the return under the statement when mapping ^expr to
expr; return; in void methods.

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

Item was changed:
  ----- Method: CCodeGenerator>>returnTypeForSend: (in category 'type inference') -----
  returnTypeForSend: aTSendNode
  	"Answer the return type for a send.  Absent sends default to #sqInt."
  	| sel |
  	^(methods at: (sel := aTSendNode selector) ifAbsent: nil)
  		ifNil: [kernelReturnTypes
  				at: sel
  				ifAbsent:
  					[^sel
  						caseOf: {
  						[#asVoidPointer]		->	[#'void *'].
  						[#asUnsignedInteger]	->	[#usqInt].
  						[#asLong]				->	[#long].
  						[#asUnsignedLong]		->	[#'unsigned long'].
  						[#signedIntToLong]		->	[#usqInt]. "c.f. generateSignedIntToLong:on:indent:"
  						[#signedIntToShort]	->	[#usqInt]. "c.f. generateSignedIntToShort:on:indent:"
  						[#cCoerce:to:]			->	[aTSendNode args last value].
  						[#cCoerceSimple:to:]	->	[aTSendNode args last value] }
  						otherwise: [#sqInt]]]
+ 		ifNotNil:
+ 			[:m|
+ 			m returnType ifNotNil:
+ 				[:type| "map fields to #usqInt"
+ 				((type beginsWith: 'unsigned')
+ 				 and: [(type includes: $:)
+ 				 and: [type last isDigit]])
+ 					ifTrue: [#usqInt]
+ 					ifFalse: [type]]]!
- 		ifNotNil: [:m| m returnType]!

Item was changed:
  ----- Method: CoInterpreter>>ceTraceBlockActivation (in category 'debug support') -----
  ceTraceBlockActivation
  	<api>
- 	<var: #cogMethod type: #'CogMethod *'>
  	cogit recordBlockTrace ifTrue:
  		[self recordTrace: TraceBlockActivation
  			thing: (self mframeHomeMethod: framePointer) methodObject
  			source: TraceIsFromMachineCode.
  		 cogit printOnTrace ifTrue:
  			[self printActivationNameFor: (self mframeHomeMethod: framePointer) methodObject
  				receiver: (self frameReceiver: framePointer)
  				isBlock: true
  				firstTemporary: nil.
  			 self cr]]!

Item was changed:
  ----- Method: CoInterpreter>>createClosureNumArgs:numCopied:startpc: (in category 'trampolines') -----
  createClosureNumArgs: numArgs numCopied: numCopied startpc: initialIP
  	<api>
  	| context newClosure |
- 	<var: #sp type: #'char *'>
  	self assert: (self isMachineCodeFrame: framePointer).
  	"Do *not* include the return pc or copied values in the stack contents;
  	 hence + ((1 + numCopied) * BytesPerWord)"
  	context := self ensureFrameIsMarried: framePointer
  					SP: stackPointer + ((1 + numCopied) * BytesPerWord).
  	newClosure := self
  					closureIn: context
  					numArgs: numArgs
  					instructionPointer: initialIP
  					numCopiedValues: numCopied.
  	cogit recordSendTrace ifTrue:
  		[self recordTrace: TraceBlockCreation thing: newClosure source: TraceIsFromMachineCode].
  	numCopied > 0 ifTrue:
  		["N.B. the expression ((numCopied - i) * BytesPerWord)) skips the return address"
  		 0 to: numCopied - 1 do:
  			[:i|
  			"Assume: have just allocated a new BlockClosure; it must be young.
  			 Thus, can use unchecked stores."
  			 objectMemory storePointerUnchecked: i + ClosureFirstCopiedValueIndex
  				ofObject: newClosure
  				withValue: (stackPages longAt: stackPointer + ((numCopied - i) * BytesPerWord))]].
  	"Assume caller will pop stack"
  	^newClosure!

Item was changed:
  ----- Method: CoInterpreter>>handleMNU:InMachineCodeTo:classForMessage: (in category 'message sending') -----
  handleMNU: selectorIndex InMachineCodeTo: rcvr classForMessage: classForMessage
  	"A message send from either an open PIC or an unlinked send has not  been
  	 understood.  Create a message and execute the relevant resulting MNU method.
  	 messageSelector is an implicit argument (yuck)."
  	| errSelIdx classForThisMessage |
- 	<var: #cogMethod type: #'CogMethod *'>
  	self assert: (objectMemory addressCouldBeOop: rcvr).
  	instructionPointer := self popStack.
  	self createActualMessageTo: classForMessage.
  	messageSelector := objectMemory splObj: selectorIndex.
  	(self lookupInMethodCacheSel: messageSelector classTag: (objectMemory classTagForClass: lkupClass))
  		ifTrue:"check for coggability because method is in the cache"
  			[self
  				ifAppropriateCompileToNativeCode: newMethod
  				selector: messageSelector]
  		ifFalse:
  			[errSelIdx := self lookupMethodNoMNUEtcInClass: (classForThisMessage := lkupClass).
  			 errSelIdx ~= 0 ifTrue:
  				[selectorIndex = SelectorDoesNotUnderstand ifTrue:
  					[self error: 'Recursive not understood error encountered'].
  				 self push: instructionPointer.
  				 ^self handleMNU: errSelIdx InMachineCodeTo: rcvr classForMessage: classForThisMessage]].
  	(self maybeMethodHasCogMethod: newMethod) ifTrue:
  		[self push: instructionPointer.
  		 self executeCogMethodFromUnlinkedSend: (self cogMethodOf: newMethod)
  			 withReceiver: rcvr.
  		 "NOTREACHED"
  		 self assert: false].
  	^self interpretMethodFromMachineCode
  	"NOTREACHED"!

Item was changed:
  ----- Method: CoInterpreter>>printFrameMethodFor: (in category 'debug printing') -----
  printFrameMethodFor: theFP
- 	| address it homeMethod obj |
  	<inline: false>
+ 	| address it homeMethod obj |
  	<var: #theFP type: #'char *'>
  	<var: #address type: #'char *'>
- 	<var: #cogMethod type: #'CogBlockMethod *'>
  	<var: #homeMethod type: #'CogMethod *'>
  
  	address := theFP + FoxMethod.
  	it := stackPages longAt: address.
  	self printHex: address asInteger;
  		printChar: $:.
  	self print: '      method: ';
  		printHex: it.
  	self tab.
  	((self isMachineCodeFrame: theFP)
  	 and: [self mframeIsBlockActivation: theFP]) ifTrue:
  		[homeMethod := self mframeHomeMethod: theFP.
  		 self print: 'hm: '; printHex: homeMethod asInteger; tab].
  	obj := self frameMethodObject: theFP.
  	self printHex: obj; space; shortPrintOop: obj!

Item was changed:
  ----- Method: CoInterpreter>>readImageFromFile:HeapSize:StartingAt: (in category 'image save/restore') -----
  readImageFromFile: f HeapSize: desiredHeapSize StartingAt: imageOffset
  	"Read an image from the given file stream, allocating the given amount of memory to its object heap. Fail if the image has an unknown format or requires more than the given amount of memory."
  	"Details: This method detects when the image was stored on a machine with the opposite byte ordering from this machine and swaps the bytes automatically. Furthermore, it allows the header information to start 512 bytes into the file, since some file transfer programs for the Macintosh apparently prepend a Mac-specific header of this size. Note that this same 512 bytes of prefix area could also be used to store an exec command on Unix systems, allowing one to launch Smalltalk by invoking the image name as a command."
  	"This code is based on C code by Ian Piumarta and Smalltalk code by Tim Rowledge. Many thanks to both of you!!!!"
  
  	| swapBytes headerStart headerSize dataSize oldBaseAddr
  	  minimumMemory heapSize bytesRead bytesToShift
  	  hdrNumStackPages hdrEdenBytes hdrCogCodeSize headerFlags hdrMaxExtSemTabSize firstSegSize |
+ 	<var: #f type: #sqImageFile>
+ 	<var: #dataSize type: #'size_t'>
+ 	<var: #desiredHeapSize type: #usqInt>
+ 	<var: #headerStart type: #squeakFileOffsetType>
+ 	<var: #imageOffset type: #squeakFileOffsetType>
- 	<var: #f type: 'sqImageFile '>
- 	<var: #memStart type: 'usqInt'>
- 	<var: #desiredHeapSize type: 'usqInt'>
- 	<var: #headerStart type: 'squeakFileOffsetType '>
- 	<var: #dataSize type: 'size_t '>
- 	<var: #imageOffset type: 'squeakFileOffsetType '>
  
  	metaclassNumSlots := 6.	"guess Metaclass instSize"
  	classNameIndex := 6.		"guess (Class instVarIndexFor: 'name' ifAbsent: []) - 1"
  	swapBytes := self checkImageVersionFrom: f startingAt: imageOffset.
  	headerStart := (self sqImageFilePosition: f) - BytesPerWord.  "record header start position"
  
  	headerSize			:= self getLongFromFile: f swap: swapBytes.
  	dataSize			:= self getLongFromFile: f swap: swapBytes.
  	oldBaseAddr		:= self getLongFromFile: f swap: swapBytes.
  	objectMemory specialObjectsOop: (self getLongFromFile: f swap: swapBytes).
  	objectMemory lastHash: (self getLongFromFile: f swap: swapBytes). "N.B.  not used."
  	savedWindowSize	:= self getLongFromFile: f swap: swapBytes.
  	headerFlags			:= self getLongFromFile: f swap: swapBytes.
  	self setImageHeaderFlagsFrom: headerFlags.
  	extraVMMemory		:= self getLongFromFile: f swap: swapBytes. "N.B.  not used."
  	hdrNumStackPages	:= self getShortFromFile: f swap: swapBytes.
  	"4 stack pages is small.  Should be able to run with as few as
  	 three. 4 should be comfortable but slow.  8 is a reasonable
  	 default.  Can be changed via vmParameterAt: 43 put: n.
  	 Can be set as a preference (Info.plist, VM.ini, command line etc).
  	 If desiredNumStackPages is already non-zero then it has been
  	 set as a preference.  Ignore (but preserve) the header's default."
  	numStackPages := desiredNumStackPages ~= 0
  						ifTrue: [desiredNumStackPages]
  						ifFalse: [hdrNumStackPages = 0
  									ifTrue: [self defaultNumStackPages]
  									ifFalse: [hdrNumStackPages]].
  	desiredNumStackPages := hdrNumStackPages.
  	"This slot holds the size of the native method zone in 1k units. (pad to word boundary)."
  	hdrCogCodeSize := (self getShortFromFile: f swap: swapBytes) * 1024.
  	cogCodeSize := desiredCogCodeSize ~= 0
  						ifTrue: [desiredCogCodeSize]
  						ifFalse:
  							[hdrCogCodeSize = 0
  									ifTrue: [self defaultCogCodeSize]
  									ifFalse: [hdrCogCodeSize]].
  	hdrEdenBytes		:= self getLongFromFile: f swap: swapBytes.
  	objectMemory edenBytes: (desiredEdenBytes ~= 0
  						ifTrue: [desiredEdenBytes]
  						ifFalse:
  							[hdrEdenBytes = 0
  									ifTrue: [objectMemory defaultEdenBytes]
  									ifFalse: [hdrEdenBytes]]).
  	desiredEdenBytes := hdrEdenBytes.
  	hdrMaxExtSemTabSize := self getShortFromFile: f swap: swapBytes.
  	hdrMaxExtSemTabSize ~= 0 ifTrue:
  		[self setMaxExtSemSizeTo: hdrMaxExtSemTabSize].
  	"pad to word boundary.  This slot can be used for anything else that will fit in 16 bits.
  	 Preserve it to be polite to other VMs."
  	the2ndUnknownShort	:= self getShortFromFile: f swap: swapBytes.
  	firstSegSize := self getLongFromFile: f swap: swapBytes.
  	objectMemory firstSegmentSize: firstSegSize.
  
  	"compare memory requirements with availability"
  	minimumMemory := cogCodeSize "no need to include the stackZone; this is alloca'ed"
  						+ dataSize
  						+ objectMemory newSpaceBytes
  						+ self interpreterAllocationReserveBytes.
  	heapSize             :=  cogCodeSize "no need to include the stackZone; this is alloca'ed"
  						+ desiredHeapSize
  						"+ edenBytes" "don't include edenBytes; this is part of the heap and so part of desiredHeapSize"
  						+ self interpreterAllocationReserveBytes.
  	heapSize < minimumMemory ifTrue:
  		[self insufficientMemorySpecifiedError].
  
  	"allocate a contiguous block of memory for the Squeak heap and ancilliary data structures"
  	objectMemory memory: (self
  								allocateMemory: heapSize
  								minimum: minimumMemory
  								imageFile: f
  								headerSize: headerSize) asUnsignedInteger.
  	
  	objectMemory memory = nil ifTrue: [self insufficientMemoryAvailableError].
  	heapBase := objectMemory memory + cogCodeSize.
  	self assert: objectMemory startOfMemory = heapBase.
  	objectMemory
  		setHeapBase: heapBase
  		memoryLimit: objectMemory memory + heapSize - 24  "decrease memoryLimit a tad for safety (?!!?!!? eem eem 10/9/2013 15:15)"
  		endOfMemory: heapBase + dataSize.
  
  	"position file after the header"
  	self sqImageFile: f Seek: headerStart + headerSize.
  
  	"read in the image in bulk, then swap the bytes if necessary"
  	bytesRead := objectMemory readHeapFromImageFile: f dataBytes: dataSize.
  	bytesRead ~= dataSize ifTrue: [self unableToReadImageError].
  
  	self ensureImageFormatIsUpToDate: swapBytes.
  
  	"compute difference between old and new memory base addresses"
  	bytesToShift := objectMemory memoryBaseForImageRead - oldBaseAddr.
  	self initializeInterpreter: bytesToShift.  "adjusts all oops to new location"
  	self initializeCodeGenerator.
  	^dataSize!

Item was changed:
  ----- Method: CogARMCompiler>>dispatchConcretize (in category 'generate machine code') -----
  dispatchConcretize
  	"Attempt to generate concrete machine code for the instruction at address.
  	 This is the inner dispatch of concretizeAt: actualAddress which exists only
  	 to get around the branch size limits in the SqueakV3 (blue book derived)
  	 bytecode set."
+ 	<returnTypeC: #void>
- 
  	opcode caseOf: {
  		"Noops & Pseudo Ops"
  		[Label]					-> [^self concretizeLabel].
  		[AlignmentNops]		-> [^self concretizeAlignmentNops].
  		[Fill16]					-> [^self concretizeFill16].
  		[Fill32]					-> [^self concretizeFill32].
  		[FillFromWord]			-> [^self concretizeFillFromWord].
  		[Nop]					-> [^self concretizeNop].
  		"Specific Control/Data Movement"
  		"[LDM]					-> [^self concretizeLDM].
  		[STM]					-> [^self concretizeSTM]."
  		"Control"
  		[Call]						-> [^self concretizeCall].
  		[JumpR]						-> [^self concretizeJumpR].
  		[JumpLong]					-> [^self concretizeConditionalJumpLong: AL].
  		[JumpLongZero]			-> [^self concretizeConditionalJumpLong: EQ].
  		[JumpLongNonZero]		-> [^self concretizeConditionalJumpLong: NE].
  		[Jump]						-> [^self concretizeConditionalJump: AL].
  		[JumpZero]					-> [^self concretizeConditionalJump: EQ].
  		[JumpNonZero]				-> [^self concretizeConditionalJump: NE].
  		[JumpNegative]				-> [^self concretizeConditionalJump: MI].
  		[JumpNonNegative]			-> [^self concretizeConditionalJump: PL].
  		[JumpOverflow]				-> [^self concretizeConditionalJump: VS].
  		[JumpNoOverflow]			-> [^self concretizeConditionalJump: VC].
  		[JumpCarry]				-> [^self concretizeConditionalJump: CS].
  		[JumpNoCarry]				-> [^self concretizeConditionalJump: CC].
  		[JumpLess]					-> [^self concretizeConditionalJump: LT].
  		[JumpGreaterOrEqual]		-> [^self concretizeConditionalJump: GE].
  		[JumpGreater]				-> [^self concretizeConditionalJump: GT].
  		[JumpLessOrEqual]			-> [^self concretizeConditionalJump: LE].
  		[JumpBelow]				-> [^self concretizeConditionalJump: CC]. "unsigned lower"
  		[JumpAboveOrEqual]		-> [^self concretizeConditionalJump: CS]. "unsigned greater or equal"
  		[JumpAbove]				-> [^self concretizeConditionalJump: HI].
  		[JumpBelowOrEqual]		-> [^self concretizeConditionalJump: LS].
  		[JumpFPEqual]				-> [^self concretizeFPConditionalJump: EQ].
  		[JumpFPNotEqual]			-> [^self concretizeFPConditionalJump: NE].
  		"[JumpFPLess]				-> [^self concretizeFPConditionalJump: LT].
  		[JumpFPGreaterOrEqual]	-> [^self concretizeFPConditionalJump: GE].
  		[JumpFPGreater]			-> [^self concretizeFPConditionalJump: GT].
  		[JumpFPLessOrEqual]		-> [^self concretizeFPConditionalJump: LE].
  		[JumpFPOrdered]			-> [^self concretizeFPConditionalJump: VC].
  		[JumpFPUnordered]			-> [^self concretizeFPConditionalJump: VS]."
  		[RetN]						-> [^self concretizeRetN].
  		"Arithmetic"
  		[AddCqR]					-> [^self concretizeAddCqR].
  		[AddCwR]					-> [^self concretizeDataOperationCwR: 4].
  		[AddRR]						-> [^self concretizeDataOperationRR: 4].
  		"[AddRdRd]					-> [^self concretizeSEE2OpRdRd: 16r58]."
  		[AndCqR]					-> [^self concretizeDataOperationCqR: 0].
  		[AndCwR]					-> [^self concretizeDataOperationCwR: 0].
  		[AndRR]						-> [^self concretizeDataOperationRR: 0].
  		[CmpCqR]					-> [^self concretizeCmpCqR].
  		[CmpCwR]					-> [^self concretizeCmpCwR].
  		[CmpRR]					-> [^self concretizeCmpRR].
  		[CmpRdRd]					-> [^self concretizeCmpRdRd].
  		"[DivRdRd]					-> [^self concretizeSEE2OpRdRd: 16r5E].
  		[MulRdRd]					-> [^self concretizeSEE2OpRdRd: 16r59]."
  		[OrCqR]						-> [^self concretizeDataOperationCqR: 16rC].
  		[OrCwR]					-> [^self concretizeDataOperationCwR: 16rC].
  		[OrRR]						-> [^self concretizeDataOperationRR: 16rC].
  		[SubCqR]					-> [^self concretizeSubCqR].
  		[SubCwR]					-> [^self concretizeDataOperationCwR: 2].
  		[SubRR]						-> [^self concretizeDataOperationRR: 2].
  		"[SubRdRd]					-> [^self concretizeSEE2OpRdRd: 16r5C]."
  		[SqrtRd]						-> [^self concretizeSqrtRd].
  		[XorCqR]						-> [^self concretizeDataOperationCqR: 1].
  		[XorCwR]						-> [^self concretizeDataOperationCwR: 1].
  		[XorRR]							-> [^self concretizeDataOperationRR: 1].
  		[NegateR]						-> [^self concretizeNegateR].
  		[LoadEffectiveAddressMwrR]	-> [^self concretizeLoadEffectiveAddressMwrR].
  		[ArithmeticShiftRightCqR]		-> [^self concretizeArithmeticShiftRightCqR].
  		[LogicalShiftRightCqR]			-> [^self concretizeLogicalShiftRightCqR].
  		[LogicalShiftLeftCqR]			-> [^self concretizeLogicalShiftLeftCqR].
  		[ArithmeticShiftRightRR]			-> [^self concretizeArithmeticShiftRightRR].
  		[LogicalShiftLeftRR]				-> [^self concretizeLogicalShiftLeftRR].
  		[LogicalShiftRightRR]			-> [^self concretizeLogicalShiftRightRR].
  		"Data Movement"
  		[MoveCqR]			-> [^self concretizeMoveCqR].
  		[MoveCwR]			-> [^self concretizeMoveCwR].
  		[MoveRR]			-> [^self concretizeMoveRR].
  		[MoveAwR]			-> [^self concretizeMoveAwR].
  		[MoveRAw]			-> [^self concretizeMoveRAw].
  		"While the two MoveMbR and MoveMwR are quite similar (off by 1 bit), they differ way more to
  		MoveM16R and MoveM64R. Because of that, they are not merged."
  		[MoveMbrR]			-> [^self concretizeMoveMbrR].
  		[MoveRMbr]			-> [^self concretizeMoveRMbr].
  		[MoveM16rR]		-> [^self concretizeMoveM16rR].
  		[MoveM64rRd]		-> [^self concretizeMoveM64rRd].
  		[MoveMwrR]		-> [^self concretizeMoveMwrR].
  		[MoveXbrRR]		-> [^self concretizeMoveXbrRR].
  		[MoveXwrRR]		-> [^self concretizeMoveXwrRR].
  		[MoveRXwrR]		-> [^self concretizeMoveRXwrR].
  		[MoveRMwr]		-> [^self concretizeMoveRMwr].
  		[MoveRdM64r]		-> [^self concretizeMoveRdM64r].
  		[PopR]				-> [^self concretizePopR].
  		[PushR]				-> [^self concretizePushR].
  		[PushCw]			-> [^self concretizePushCw].
  		[PrefetchAw]		-> [^self concretizePrefetchAw].
  		"Conversion"
  		[ConvertRRd]		-> [^self concretizeConvertRRd].
  		"ARM specific opcodes" 
  		[LDMFD]			-> [^self concretizeLDMFD].
  		[STMFD]			-> [^self concretizeSTMFD]	}!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeConditionalJump: (in category 'generate machine code') -----
  concretizeConditionalJump: conditionCode
  	"Will get inlined into concretizeAt: switch."
  	"Sizing/generating jumps.
  		Jump targets can be to absolute addresses or other abstract instructions.
  		Generating initial trampolines instructions may have no maxSize and be to absolute addresses.
  		Otherwise instructions must have a machineCodeSize which must be kept to."
  	<inline: true>
  	| offset |
- 	<var: #jumpTarget type: #'AbstractInstruction *'>
  	offset := self computeJumpTargetOffsetPlus: 2.
  	(machineCodeSize = 0 "size not determined because no sizeJump pass; generating initial trampolines"
  		ifTrue: [self isQuick: offset]
  		ifFalse: [machineCodeSize = 2]) ifTrue:
  		[machineCode
  			at: 0 put: 16r70 + conditionCode;
  			at: 1 put: (offset bitAnd: 16rFF).
  		 ^machineCodeSize := 2].
  	^self concretizeConditionalJumpLong: conditionCode!

Item was changed:
  ----- Method: CogIA32Compiler>>dispatchConcretize (in category 'generate machine code') -----
  dispatchConcretize
  	"Attempt to generate concrete machine code for the instruction at address.
  	 This is the inner dispatch of concretizeAt: actualAddress which exists only
  	 to get around the branch size limits in the SqueakV3 (blue book derived)
  	 bytecode set."
+ 	<returnTypeC: #void>
- 
  	opcode caseOf: {
  		"Noops & Pseudo Ops"
  		[Label]				-> [^self concretizeLabel].
  		[AlignmentNops]	-> [^self concretizeAlignmentNops].
  		[Fill16]				-> [^self concretizeFill16].
  		[Fill32]				-> [^self concretizeFill32].
  		[FillFromWord]		-> [^self concretizeFillFromWord].
  		[Nop]				-> [^self concretizeNop].
  		"Specific Control/Data Movement"
  		[CDQ]					-> [^self concretizeCDQ].
  		[IDIVR]					-> [^self concretizeIDIVR].
  		[IMULRR]				-> [^self concretizeMulRR].
  		[CPUID]					-> [^self concretizeCPUID].
  		[CMPXCHGAwR]			-> [^self concretizeCMPXCHGAwR].
  		[CMPXCHGMwrR]		-> [^self concretizeCMPXCHGMwrR].
  		[LFENCE]				-> [^self concretizeFENCE: 5].
  		[MFENCE]				-> [^self concretizeFENCE: 6].
  		[SFENCE]				-> [^self concretizeFENCE: 7].
  		[LOCK]					-> [^self concretizeLOCK].
  		[XCHGAwR]				-> [^self concretizeXCHGAwR].
  		[XCHGMwrR]			-> [^self concretizeXCHGMwrR].
  		[XCHGRR]				-> [^self concretizeXCHGRR].
  		"Control"
  		[Call]					-> [^self concretizeCall].
  		[JumpR]					-> [^self concretizeJumpR].
  		[JumpLong]				-> [^self concretizeJumpLong].
  		[JumpLongZero]		-> [^self concretizeConditionalJumpLong: 16r4].
  		[JumpLongNonZero]	-> [^self concretizeConditionalJumpLong: 16r5].
  		[Jump]					-> [^self concretizeJump].
  		"Table B-1 Intel® 64 and IA-32 Architectures Software Developer's Manual Volume 1: Basic Architecture"
  		[JumpZero]				-> [^self concretizeConditionalJump: 16r4].
  		[JumpNonZero]			-> [^self concretizeConditionalJump: 16r5].
  		[JumpNegative]			-> [^self concretizeConditionalJump: 16r8].
  		[JumpNonNegative]		-> [^self concretizeConditionalJump: 16r9].
  		[JumpOverflow]			-> [^self concretizeConditionalJump: 16r0].
  		[JumpNoOverflow]		-> [^self concretizeConditionalJump: 16r1].
  		[JumpCarry]			-> [^self concretizeConditionalJump: 16r2].
  		[JumpNoCarry]			-> [^self concretizeConditionalJump: 16r3].
  		[JumpLess]				-> [^self concretizeConditionalJump: 16rC].
  		[JumpGreaterOrEqual]	-> [^self concretizeConditionalJump: 16rD].
  		[JumpGreater]			-> [^self concretizeConditionalJump: 16rF].
  		[JumpLessOrEqual]		-> [^self concretizeConditionalJump: 16rE].
  		[JumpBelow]			-> [^self concretizeConditionalJump: 16r2].
  		[JumpAboveOrEqual]	-> [^self concretizeConditionalJump: 16r3].
  		[JumpAbove]			-> [^self concretizeConditionalJump: 16r7].
  		[JumpBelowOrEqual]	-> [^self concretizeConditionalJump: 16r6].
  		[JumpFPEqual]				-> [^self concretizeConditionalJump: 16r4].
  		[JumpFPNotEqual]			-> [^self concretizeConditionalJump: 16r5].
  		[JumpFPLess]				-> [^self concretizeConditionalJump: 16r2].
  		[JumpFPGreaterOrEqual]	-> [^self concretizeConditionalJump: 16r3].
  		[JumpFPGreater]			-> [^self concretizeConditionalJump: 16r7].
  		[JumpFPLessOrEqual]		-> [^self concretizeConditionalJump: 16r6].
  		[JumpFPOrdered]			-> [^self concretizeConditionalJump: 16rB].
  		[JumpFPUnordered]			-> [^self concretizeConditionalJump: 16rA].
  		[RetN]						-> [^self concretizeRetN].
  		"Arithmetic"
  		[AddCqR]					-> [^self concretizeAddCqR].
  		[AddCwR]					-> [^self concretizeAddCwR].
  		[AddRR]						-> [^self concretizeAddRR].
  		[AddRdRd]					-> [^self concretizeSEE2OpRdRd: 16r58].
  		[AndCqR]					-> [^self concretizeAndCqR].
  		[AndCwR]					-> [^self concretizeAndCwR].
  		[AndRR]						-> [^self concretizeAndRR].
  		[CmpCqR]					-> [^self concretizeCmpCqR].
  		[CmpCwR]					-> [^self concretizeCmpCwR].
  		[CmpRR]					-> [^self concretizeCmpRR].
  		[CmpRdRd]					-> [^self concretizeCmpRdRd].
  		[DivRdRd]					-> [^self concretizeSEE2OpRdRd: 16r5E].
  		[MulRdRd]					-> [^self concretizeSEE2OpRdRd: 16r59].
  		[OrCqR]						-> [^self concretizeOrCqR].
  		[OrCwR]					-> [^self concretizeOrCwR].
  		[OrRR]						-> [^self concretizeOrRR].
  		[SubCqR]					-> [^self concretizeSubCqR].
  		[SubCwR]					-> [^self concretizeSubCwR].
  		[SubRR]						-> [^self concretizeSubRR].
  		[SubRdRd]					-> [^self concretizeSEE2OpRdRd: 16r5C].
  		[SqrtRd]						-> [^self concretizeSqrtRd].
  		[XorCwR]						-> [^self concretizeXorCwR].
  		[XorRR]							-> [^self concretizeXorRR].
  		[NegateR]						-> [^self concretizeNegateR].
  		[LoadEffectiveAddressMwrR]	-> [^self concretizeLoadEffectiveAddressMwrR].
  		[ArithmeticShiftRightCqR]		-> [^self concretizeArithmeticShiftRightCqR].
  		[LogicalShiftRightCqR]			-> [^self concretizeLogicalShiftRightCqR].
  		[LogicalShiftLeftCqR]			-> [^self concretizeLogicalShiftLeftCqR].
  		[ArithmeticShiftRightRR]			-> [^self concretizeArithmeticShiftRightRR].
  		[LogicalShiftLeftRR]				-> [^self concretizeLogicalShiftLeftRR].
  		"Data Movement"
  		[MoveCqR]			-> [^self concretizeMoveCqR].
  		[MoveCwR]			-> [^self concretizeMoveCwR].
  		[MoveRR]			-> [^self concretizeMoveRR].
  		[MoveAwR]			-> [^self concretizeMoveAwR].
  		[MoveRAw]			-> [^self concretizeMoveRAw].
  		[MoveMbrR]			-> [^self concretizeMoveMbrR].
  		[MoveRMbr]			-> [^self concretizeMoveRMbr].
  		[MoveM16rR]		-> [^self concretizeMoveM16rR].
  		[MoveM64rRd]		-> [^self concretizeMoveM64rRd].
  		[MoveMwrR]		-> [^self concretizeMoveMwrR].
  		[MoveXbrRR]		-> [^self concretizeMoveXbrRR].
  		[MoveXwrRR]		-> [^self concretizeMoveXwrRR].
  		[MoveRXwrR]		-> [^self concretizeMoveRXwrR].
  		[MoveRMwr]		-> [^self concretizeMoveRMwr].
  		[MoveRdM64r]		-> [^self concretizeMoveRdM64r].
  		[PopR]				-> [^self concretizePopR].
  		[PushR]				-> [^self concretizePushR].
  		[PushCw]			-> [^self concretizePushCw].
  		[PrefetchAw]		-> [^self concretizePrefetchAw].
  		"Conversion"
  		[ConvertRRd]		-> [^self concretizeConvertRRd] }!

Item was changed:
  ----- Method: CogObjectRepresentationForSqueakV3>>genInnerPrimitiveSize: (in category 'primitive generators') -----
  genInnerPrimitiveSize: retNoffset
  	| jumpSI jumpNotIndexable jumpIsContext |
  	"c.f. StackInterpreter>>stSizeOf: lengthOf:baseHeader:format: fixedFieldsOf:format:length:"
+ 	<var: #jumpSI type: #'AbstractInstruction *'>
- 	<var: #jumpNotSI type: #'AbstractInstruction *'>
  	<var: #jumpNotIndexable type: #'AbstractInstruction *'>
  	<var: #jumpIsContext type: #'AbstractInstruction *'>
  	cogit MoveR: ReceiverResultReg R: TempReg.
  	jumpSI := self genJumpSmallIntegerInScratchReg: TempReg.
  	self
  		genGetSizeOf: ReceiverResultReg
  		into: ClassReg
  		formatReg: SendNumArgsReg
  		scratchReg: TempReg
  		abortJumpsInto: [:jnx :jic| jumpNotIndexable := jnx. jumpIsContext := jic].
  	self genConvertIntegerToSmallIntegerInScratchReg: ClassReg.
  	cogit MoveR: ClassReg R: ReceiverResultReg.
  	cogit RetN: retNoffset.
  	jumpSI jmpTarget: (jumpNotIndexable jmpTarget: (jumpIsContext jmpTarget: cogit Label)).
  	^0!

Item was changed:
  ----- Method: Cogit>>generateCogMethod: (in category 'generate machine code') -----
  generateCogMethod: selector
  	"We handle jump sizing simply.  First we make a pass that asks each
  	 instruction to compute its maximum size.  Then we make a pass that
  	 sizes jumps based on the maxmimum sizes.  Then we make a pass
  	 that fixes up jumps.  When fixing up a jump the jump is not allowed to
  	 choose a smaller offset but must stick to the size set in the second pass."
+ 	<returnTypeC: #'CogMethod *'>
  	| codeSize headerSize mapSize totalSize startAddress result method |
  	<var: #method type: #'CogMethod *'>
- 	<var: #blockStart type: #'BlockStart *'>
- 	<var: #headerReference type: #'AbstractInstruction *'>
- 	<returnTypeC: #'CogMethod *'>
  	headerSize := self sizeof: CogMethod.
  	methodLabel address: headerSize negated.
  	self computeMaximumSizes.
  	methodLabel concretizeAt: methodZone freeStart.
  	codeSize := self generateInstructionsAt: methodLabel address + headerSize.
  	mapSize := self generateMapAt: 0 start: methodLabel address + cmNoCheckEntryOffset.
  	totalSize := methodZone roundUpLength: headerSize + codeSize + mapSize.
  	totalSize > MaxMethodSize ifTrue:
  		[^self cCoerceSimple: MethodTooBig to: #'CogMethod *'].
  	startAddress := methodZone allocate: totalSize.
  	startAddress = 0 ifTrue:
  		[^self cCoerceSimple: InsufficientCodeSpace to: #'CogMethod *'].
  	self assert: startAddress + cmEntryOffset = entry address.
  	self assert: startAddress + cmNoCheckEntryOffset = noCheckEntry address.
  	result := self outputInstructionsAt: startAddress + headerSize.
  	self assert: startAddress + headerSize + codeSize = result.
  	backEnd padIfPossibleWithNopsFrom: result to: startAddress + totalSize - mapSize.
  	self generateMapAt: startAddress + totalSize - 1 start: startAddress + cmNoCheckEntryOffset.
  	self fillInBlockHeadersAt: startAddress.
  	method := self fillInMethodHeader: (self cCoerceSimple: startAddress to: #'CogMethod *')
  					size: totalSize
  					selector: selector.
  	postCompileHook notNil ifTrue:
  		[self perform: postCompileHook with: method with: primInvokeLabel.
  		 postCompileHook := nil].
  	processor flushICacheFrom: startAddress to: startAddress + headerSize + codeSize.
  	^method!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genPrimitiveDiv (in category 'primitive generators') -----
  genPrimitiveDiv
  	| jumpNotSI jumpZero jumpExact jumpSameSign convert |
+ 	<var: #convert type: #'AbstractInstruction *'>
- 	<var: #jumpNotSI type: #'AbstractInstruction *'>
  	<var: #jumpZero type: #'AbstractInstruction *'>
+ 	<var: #jumpNotSI type: #'AbstractInstruction *'>
  	<var: #jumpExact type: #'AbstractInstruction *'>
  	<var: #jumpSameSign type: #'AbstractInstruction *'>
- 	<var: #jumpOverflow type: #'AbstractInstruction *'>
- 	<var: #convert type: #'AbstractInstruction *'>
  	self MoveMw: BytesPerWord r: SPReg R: TempReg.
  	self MoveR: TempReg R: ClassReg.
  	self MoveR: TempReg R: Arg1Reg.
  	jumpNotSI := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg.
  	"We must shift away the tags, not just subtract them, so that the
  	 overflow case doesn't actually overflow the machine instruction."
  	objectRepresentation genShiftAwaySmallIntegerTagsInScratchReg: ClassReg.
  	(self lastOpcode setsConditionCodesFor: JumpZero) ifFalse:
  		[self CmpCq: 0 R: ClassReg].
  	jumpZero := self JumpZero: 0.
  	self MoveR: ReceiverResultReg R: TempReg.
  	objectRepresentation genShiftAwaySmallIntegerTagsInScratchReg: TempReg.
  	self DivR: ClassReg R: TempReg Quo: TempReg Rem: ClassReg.
  	"If remainder is zero we must check for overflow."
  	self CmpCq: 0 R: ClassReg.
  	jumpExact := self JumpZero: 0.
  	"If arg and remainder signs are different we must round down."
  	self XorR: ClassReg R: Arg1Reg.
  	(self lastOpcode setsConditionCodesFor: JumpZero) ifFalse:
  		[self CmpCq: 0 R: Arg1Reg].
  	jumpSameSign := self JumpGreaterOrEqual: 0.
  	self SubCq: 1 R: TempReg.
  	jumpSameSign jmpTarget: (convert := self Label).
  	objectRepresentation genConvertIntegerToSmallIntegerInScratchReg: TempReg.
  	self MoveR: TempReg R: ReceiverResultReg.
  	self flag: 'currently caller pushes result'.
  	self RetN: BytesPerWord * 2.
  	"test for overflow; the only case is SmallInteger minVal // -1"
  	jumpExact jmpTarget:
  		(self CmpCq: (1 << (objectRepresentation numSmallIntegerBits - 1)) R: TempReg).
  	self JumpLess: convert.
  	jumpZero jmpTarget: (jumpNotSI jmpTarget: self Label).
  	^0!

Item was changed:
  ----- Method: SistaStackToRegisterMappingCogit>>generateCogMethod: (in category 'generate machine code') -----
  generateCogMethod: selector
  	"We handle jump sizing simply.  First we make a pass that asks each
  	 instruction to compute its maximum size.  Then we make a pass that
  	 sizes jumps based on the maxmimum sizes.  Then we make a pass
  	 that fixes up jumps.  When fixing up a jump the jump is not allowed to
  	 choose a smaller offset but must stick to the size set in the second pass.
  
  	 Override to add counters"
+ 	<returnTypeC: #'CogMethod *'>
  	| codeSize headerSize mapSize countersSize totalSize startAddress result method |
  	<var: #method type: #'CogMethod *'>
- 	<var: #blockStart type: #'BlockStart *'>
- 	<var: #headerReference type: #'AbstractInstruction *'>
- 	<returnTypeC: #'CogMethod *'>
  	headerSize := self sizeof: CogMethod.
  	methodLabel address: headerSize negated.
  	self computeMaximumSizes.
  	methodLabel concretizeAt: (methodZone allocate: 0).
  	codeSize := self generateInstructionsAt: methodLabel address + headerSize.
  	mapSize := self generateMapAt: 0 start: methodLabel address + cmNoCheckEntryOffset.
  	countersSize := counterIndex * CounterBytes.
  	totalSize := methodZone roundUpLength: headerSize + codeSize + mapSize + countersSize.
  	totalSize > MaxMethodSize ifTrue:
  		[^self cCoerceSimple: MethodTooBig to: #'CogMethod *'].
  	startAddress := methodZone allocate: totalSize.
  	startAddress = 0 ifTrue:
  		[^self cCoerceSimple: InsufficientCodeSpace to: #'CogMethod *'].
  	self assert: startAddress + cmEntryOffset = entry address.
  	self assert: startAddress + cmNoCheckEntryOffset = noCheckEntry address.
  	self regenerateCounterReferences: startAddress + totalSize.
  	result := self outputInstructionsAt: startAddress + headerSize.
  	self assert: startAddress + headerSize + codeSize = result.
  	backEnd nopsFrom: result to: startAddress + totalSize - mapSize.
  	self generateMapAt: startAddress + totalSize - countersSize - 1 start: startAddress + cmNoCheckEntryOffset.
  	self fillInBlockHeadersAt: startAddress.
  	self fillInCounters: counterIndex atEndAddress: startAddress + totalSize.
  	method := self fillInMethodHeader: (self cCoerceSimple: startAddress to: #'CogMethod *')
  					size: totalSize
  					selector: selector.
  	postCompileHook notNil ifTrue:
  		[self perform: postCompileHook with: method with: primInvokeLabel.
  		 postCompileHook := nil].
  	processor flushICacheFrom: startAddress to: startAddress + headerSize + codeSize.
  	^method!

Item was changed:
  ----- Method: StackInterpreter>>readImageFromFile:HeapSize:StartingAt: (in category 'image save/restore') -----
  readImageFromFile: f HeapSize: desiredHeapSize StartingAt: imageOffset
  	"Read an image from the given file stream, allocating the given amount of memory to its object heap. Fail if the image has an unknown format or requires more than the given amount of memory."
  	"Details: This method detects when the image was stored on a machine with the opposite byte ordering from this machine and swaps the bytes automatically. Furthermore, it allows the header information to start 512 bytes into the file, since some file transfer programs for the Macintosh apparently prepend a Mac-specific header of this size. Note that this same 512 bytes of prefix area could also be used to store an exec command on Unix systems, allowing one to launch Smalltalk by invoking the image name as a command."
  	"This code is based on C code by Ian Piumarta and Smalltalk code by Tim Rowledge. Many thanks to both of you!!!!"
  
  	| swapBytes headerStart headerSize dataSize oldBaseAddr hdrNumStackPages
  	  minimumMemory heapBase bytesRead bytesToShift heapSize hdrEdenBytes
  	  headerFlags hdrMaxExtSemTabSize firstSegSize |
+ 	<var: #f type: #sqImageFile>
+ 	<var: #dataSize type: #'size_t'>
+ 	<var: #heapBase type: #usqInt>
+ 	<var: #desiredHeapSize type: #usqInt>
+ 	<var: #headerStart type: #squeakFileOffsetType>
+ 	<var: #imageOffset type: #squeakFileOffsetType>
- 	<var: #f type: 'sqImageFile '>
- 	<var: #heapBase type: 'usqInt'>
- 	<var: #desiredHeapSize type: 'usqInt'>
- 	<var: #headerStart type: 'squeakFileOffsetType '>
- 	<var: #dataSize type: 'size_t '>
- 	<var: #imageOffset type: 'squeakFileOffsetType '>
  
  	metaclassNumSlots := 6.	"guess Metaclass instSize"
  	classNameIndex := 6.		"guess (Class instVarIndexFor: 'name' ifAbsent: []) - 1"
  	swapBytes := self checkImageVersionFrom: f startingAt: imageOffset.
  	headerStart := (self sqImageFilePosition: f) - BytesPerWord.  "record header start position"
  
  	headerSize			:= self getLongFromFile: f swap: swapBytes.
  	dataSize			:= self getLongFromFile: f swap: swapBytes.
  	oldBaseAddr		:= self getLongFromFile: f swap: swapBytes.
  	objectMemory specialObjectsOop: (self getLongFromFile: f swap: swapBytes).
  	objectMemory lastHash: (self getLongFromFile: f swap: swapBytes). "N.B.  not used."
  	savedWindowSize	:= self getLongFromFile: f swap: swapBytes.
  	headerFlags		:= self getLongFromFile: f swap: swapBytes.
  	self setImageHeaderFlagsFrom: headerFlags.
  	extraVMMemory	:= self getLongFromFile: f swap: swapBytes.
  	hdrNumStackPages	:= self getShortFromFile: f swap: swapBytes.
  	"4 stack pages is small.  Should be able to run with as few as
  	 three. 4 should be comfortable but slow.  8 is a reasonable
  	 default.  Can be changed via vmParameterAt: 43 put: n.
  	 Can be set as a preference (Info.plist, VM.ini, command line etc).
  	 If desiredNumStackPages is already non-zero then it has been
  	 set as a preference.  Ignore (but preserve) the header's default."
  	numStackPages := desiredNumStackPages ~= 0
  						ifTrue: [desiredNumStackPages]
  						ifFalse: [hdrNumStackPages = 0
  									ifTrue: [self defaultNumStackPages]
  									ifFalse: [hdrNumStackPages]].
  	desiredNumStackPages := hdrNumStackPages.
  	"pad to word boundary.  This slot can be used for anything else that will fit in 16 bits.
  	 It is used for the cog code size in Cog.  Preserve it to be polite to other VMs."
  	theUnknownShort	:= self getShortFromFile: f swap: swapBytes.
  	hdrEdenBytes		:= self getLongFromFile: f swap: swapBytes.
  	objectMemory edenBytes: (desiredEdenBytes ~= 0
  						ifTrue: [desiredEdenBytes]
  						ifFalse:
  							[hdrEdenBytes = 0
  									ifTrue: [objectMemory defaultEdenBytes]
  									ifFalse: [hdrEdenBytes]]).
  	desiredEdenBytes := hdrEdenBytes.
  	hdrMaxExtSemTabSize := self getShortFromFile: f swap: swapBytes.
  	hdrMaxExtSemTabSize ~= 0 ifTrue:
  		[self setMaxExtSemSizeTo: hdrMaxExtSemTabSize].
  	"pad to word boundary.  This slot can be used for anything else that will fit in 16 bits.
  	 Preserve it to be polite to other VMs."
  	the2ndUnknownShort	:= self getShortFromFile: f swap: swapBytes.
  	firstSegSize := self getLongFromFile: f swap: swapBytes.
  	objectMemory firstSegmentSize: firstSegSize.
  	"decrease Squeak object heap to leave extra memory for the VM"
  	heapSize := self cCode: 'reserveExtraCHeapBytes(desiredHeapSize, extraVMMemory)'.
  
  	"compare memory requirements with availability".
  	minimumMemory := dataSize + objectMemory newSpaceBytes + self interpreterAllocationReserveBytes.
  	heapSize < minimumMemory ifTrue:
  		[self insufficientMemorySpecifiedError].
  
  	"allocate a contiguous block of memory for the Squeak heap"
  	objectMemory memory: (self
  								allocateMemory: heapSize
  								minimum: minimumMemory
  								imageFile: f
  								headerSize: headerSize) asUnsignedInteger.
  	objectMemory memory = nil ifTrue: [self insufficientMemoryAvailableError].
  
  	heapBase := objectMemory memory.
  	objectMemory
  		setHeapBase: heapBase
  		memoryLimit: (heapBase + heapSize) - 24  "decrease memoryLimit a tad for safety"
  		endOfMemory: heapBase + dataSize.
  
  	"position file after the header"
  	self sqImageFile: f Seek: headerStart + headerSize.
  
  	"read in the image in bulk, then swap the bytes if necessary"
  	bytesRead := objectMemory readHeapFromImageFile: f dataBytes: dataSize.
  	bytesRead ~= dataSize ifTrue: [self unableToReadImageError].
  
  	self ensureImageFormatIsUpToDate: swapBytes.
  
  	"compute difference between old and new memory base addresses"
  	bytesToShift := objectMemory memoryBaseForImageRead - oldBaseAddr.
  	self initializeInterpreter: bytesToShift.  "adjusts all oops to new location"
  	^dataSize!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genPICMissTrampolineFor: (in category 'initialization') -----
  genPICMissTrampolineFor: numArgs
- 	| startAddress |
- 	<var: #aString type: #'char *'>
  	<inline: false>
+ 	| startAddress |
  	startAddress := methodZoneBase.
  	opcodeIndex := 0.
  	"N.B. a closed PIC jumps to the miss routine, not calls it, so there is only one retpc on the stack."
  	self genPushRegisterArgsForNumArgs: numArgs.
  	self genTrampolineFor: #ceCPICMiss:receiver:
  		called: (self trampolineName: 'cePICMiss' numArgs: (numArgs <= self numRegArgs ifTrue: [numArgs] ifFalse: [-1]))
  		callJumpBar: true
  		numArgs: 2
  		arg: ClassReg
  		arg: ReceiverResultReg
  		arg: nil
  		arg: nil
  		saveRegs: false
  		resultReg: nil
  		appendOpcodes: true.
  	^startAddress!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genPrimitiveDiv (in category 'primitive generators') -----
  genPrimitiveDiv
  	| jumpNotSI jumpZero jumpExact jumpSameSign convert |
+ 	<var: #convert type: #'AbstractInstruction *'>
- 	<var: #jumpNotSI type: #'AbstractInstruction *'>
  	<var: #jumpZero type: #'AbstractInstruction *'>
+ 	<var: #jumpNotSI type: #'AbstractInstruction *'>
  	<var: #jumpExact type: #'AbstractInstruction *'>
  	<var: #jumpSameSign type: #'AbstractInstruction *'>
- 	<var: #jumpOverflow type: #'AbstractInstruction *'>
- 	<var: #convert type: #'AbstractInstruction *'>
  	self MoveR: Arg0Reg R: TempReg.
  	self MoveR: Arg0Reg R: ClassReg.
  	self MoveR: Arg0Reg R: Arg1Reg.
  	jumpNotSI := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg.
  	"We must shift away the tags, not just subtract them, so that the
  	 overflow case doesn't actually overflow the machine instruction."
  	objectRepresentation genShiftAwaySmallIntegerTagsInScratchReg: ClassReg.
  	(self lastOpcode setsConditionCodesFor: JumpZero) ifFalse:
  		[self CmpCq: 0 R: ClassReg].
  	jumpZero := self JumpZero: 0.
  	self MoveR: ReceiverResultReg R: TempReg.
  	objectRepresentation genShiftAwaySmallIntegerTagsInScratchReg: TempReg.
  	self DivR: ClassReg R: TempReg Quo: TempReg Rem: ClassReg.
  	"If remainder is zero we must check for overflow."
  	self CmpCq: 0 R: ClassReg.
  	jumpExact := self JumpZero: 0.
  	"If arg and remainder signs are different we must round down."
  	self XorR: ClassReg R: Arg1Reg.
  	(self lastOpcode setsConditionCodesFor: JumpZero) ifFalse:
  		[self CmpCq: 0 R: Arg1Reg].
  	jumpSameSign := self JumpGreaterOrEqual: 0.
  	self SubCq: 1 R: TempReg.
  	jumpSameSign jmpTarget: (convert := self Label).
  	objectRepresentation genConvertIntegerToSmallIntegerInScratchReg: TempReg.
  	self MoveR: TempReg R: ReceiverResultReg.
  	self RetN: 0.
  	"test for overflow; the only case is SmallInteger minVal // -1"
  	jumpExact jmpTarget:
  		(self CmpCq: (1 << (objectRepresentation numSmallIntegerBits - 1)) R: TempReg).
  	self JumpLess: convert.
  	jumpZero jmpTarget: (jumpNotSI jmpTarget: self Label).
  	^0!

Item was changed:
  ----- Method: TMethod>>harmonizeSignedAndUnsignedTypesIn: (in category 'type inference') -----
  harmonizeSignedAndUnsignedTypesIn: aSetOfTypes
  	"Eliminate signed/unsigned conflicts in aSetOfTypes"
  	| sqs usqs |
+ 	#(char short int #'unsigned char' #'unsigned short' #'unsigned int')
+ 		with: #(sqInt sqInt sqInt #usqInt #usqInt #usqInt)
+ 		do: [:type :replacement|
+ 			(aSetOfTypes includes: type) ifTrue:
+ 				[aSetOfTypes remove: type; add: replacement]].
  	sqs := aSetOfTypes select: [:t| t beginsWith: 'sq'].
  	usqs := aSetOfTypes select: [:t| t beginsWith: 'usq'].
  	^(sqs size + usqs size = aSetOfTypes size
  	   and: [sqs notEmpty
  	   and: [sqs allSatisfy: [:t| usqs includes: 'u', t]]])
  		ifTrue: [sqs]
  		ifFalse: [aSetOfTypes]!

Item was changed:
  ----- Method: TMethod>>inferReturnTypeFromReturnsIn: (in category 'type inference') -----
  inferReturnTypeFromReturnsIn: aCodeGen
  	"Attempt to infer the return type of the receiver from returns in the parse tree."
  
  	returnType ifNil: "the initial default"
  		[aCodeGen
  			pushScope: declarations
  			while:
  				[| hasReturn returnTypes |
  				 hasReturn := false.
  				 returnTypes := Set new.
  				 parseTree nodesDo:
  					[:node|
  					node isReturn ifTrue:
  						[hasReturn := true.
  						 self addTypesFor: node expression to: returnTypes in: aCodeGen]].
  				returnTypes remove: #implicit ifAbsent: [].
  				returnTypes := self harmonizeSignedAndUnsignedTypesIn: returnTypes.
  				hasReturn
  					ifTrue:
  						[returnTypes size > 1 ifTrue:
+ 							[aCodeGen logger show:
+ 								(String streamContents:
+ 									[:s|
+ 									 s nextPutAll: 'conflicting return types '.
+ 									 returnTypes
+ 										do: [:t| s nextPutAll: t]
+ 										separatedBy: [s nextPutAll: ', '].
+ 									 s nextPutAll: ' in '; nextPutAll: selector; cr])].
- 							[aCodeGen logger nextPutAll: 'conflicting return types', (String streamContents: [:s| returnTypes do: [:t| s space; nextPutAll: t]]), ' in ', selector; cr; flush].
  						 returnTypes size = 1 ifTrue:
  							[self returnType: returnTypes anyOne]]
  					ifFalse:
  						[self returnType: (aCodeGen implicitReturnTypeFor: selector)]]]!

Item was changed:
  ----- Method: TReturnNode>>emitCCodeOn:level:generator: (in category 'C code generation') -----
  emitCCodeOn: aStream level: level generator: aCodeGen
  
  	(expression isSwitch
  	 or: [expression isCaseStmt]) ifTrue:
  		[^expression emitCCodeOn: aStream addToEndOfCases: self level: level generator: aCodeGen].
  
  	('void' = aCodeGen currentMethod returnType) ifTrue: [
  		"If the function is void, don't say 'return x' instead say ' x; return' "
  		expression isLeaf ifFalse: [
  			expression emitCCodeAsArgumentOn: aStream level: level generator: aCodeGen.	
+ 			aStream nextPut: $;; crtab: level.
- 			aStream nextPutAll: ';'; space.
  		].
  		aStream nextPutAll: 'return'.
  	] ifFalse: [
  		aStream nextPutAll: 'return'.
  		aStream space.
  		expression emitCCodeAsArgumentOn: aStream level: level generator: aCodeGen
  	].!



More information about the Vm-dev mailing list