[Vm-dev] VM Maker: VMMaker.oscog-eem.1600.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed Dec 16 19:43:51 UTC 2015
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1600.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.1600
Author: eem
Time: 16 December 2015, 11:42:04.583 am
UUID: 41892ed9-b511-421c-beae-837cfcb0e2c1
Ancestors: VMMaker.oscog-eem.1599
Add missing exports from SPurMemoryManager to cogits. On 64-bits defaulting to int foo(int bar) is not merely illegal in C99 but often disastrous.
Do a better job managing comment production in statement lists by adding variables to CCodeGenerator that track the last comment node and whether that comment was a comment from an inlining decision.
Rewrite some of the optional run-time routine generators to avoid generating empty functions.
=============== Diff against VMMaker.oscog-eem.1599 ===============
Item was changed:
Object subclass: #CCodeGenerator
+ instanceVariableNames: 'vmClass structClasses translationDict asArgumentTranslationDict inlineList constants variables variableDeclarations scopeStack methods macros apiMethods apiVariables kernelReturnTypes currentMethod headerFiles globalVariableUsage useSymbolicConstants generateDeadCode requiredSelectors previousCommentMarksInlining previousCommenter logger suppressAsmLabels asmLabelCounts pools selectorTranslations optionsDictionary breakSrcInlineSelectors breakDestInlineSelectors breakOnInline vmMaker'
- instanceVariableNames: 'vmClass structClasses translationDict asArgumentTranslationDict inlineList constants variables variableDeclarations scopeStack methods macros apiMethods apiVariables kernelReturnTypes currentMethod headerFiles globalVariableUsage useSymbolicConstants generateDeadCode requiredSelectors logger suppressAsmLabels asmLabelCounts pools selectorTranslations optionsDictionary breakSrcInlineSelectors breakDestInlineSelectors breakOnInline vmMaker'
classVariableNames: 'NoRegParmsInAssertVMs'
poolDictionaries: 'VMBasicConstants'
category: 'VMMaker-Translation to C'!
!CCodeGenerator commentStamp: 'tpr 5/2/2003 14:30' prior: 0!
This class oversees the translation of a subset of Smalltalk to C, allowing the comforts of Smalltalk during development and the efficiency and portability of C for the resulting interpreter.
See VMMaker for more useful info!
Item was changed:
----- Method: CCodeGenerator>>currentMethod: (in category 'accessing') -----
currentMethod: aTMethod
+ previousCommenter := nil.
currentMethod := aTMethod!
Item was changed:
+ ----- Method: CCodeGenerator>>initialize (in category 'initialize-release') -----
- ----- Method: CCodeGenerator>>initialize (in category 'public') -----
initialize
translationDict := Dictionary new.
inlineList := Array new.
constants := Dictionary new: 100.
variables := Set new: 100.
variableDeclarations := Dictionary new: 100.
methods := Dictionary new: 500.
kernelReturnTypes := self computeKernelReturnTypes.
macros := Dictionary new.
self initializeCTranslationDictionary.
headerFiles := OrderedCollection new.
globalVariableUsage := Dictionary new.
useSymbolicConstants := true.
generateDeadCode := true.
scopeStack := OrderedCollection new.
logger := (ProvideAnswerNotification new tag: #logger; signal) ifNil: [Transcript].
pools := IdentitySet new.
selectorTranslations := IdentityDictionary new.
suppressAsmLabels := false.
+ previousCommentMarksInlining := false.
+ previousCommenter := nil.
breakSrcInlineSelectors := IdentitySet new.
breakDestInlineSelectors := IdentitySet new!
Item was added:
+ ----- Method: CCodeGenerator>>previousCommentMarksInlining (in category 'accessing') -----
+ previousCommentMarksInlining
+ ^previousCommentMarksInlining!
Item was added:
+ ----- Method: CCodeGenerator>>previousCommentMarksInlining: (in category 'accessing') -----
+ previousCommentMarksInlining: aBoolean
+ | previousValue |
+ previousValue := previousCommentMarksInlining.
+ previousCommentMarksInlining := aBoolean.
+ ^previousValue!
Item was added:
+ ----- Method: CCodeGenerator>>previousCommenter (in category 'accessing') -----
+ previousCommenter
+ ^previousCommenter!
Item was added:
+ ----- Method: CCodeGenerator>>previousCommenter: (in category 'accessing') -----
+ previousCommenter: aTParseNodeOrNil
+ | previousValue |
+ previousValue := previousCommenter.
+ previousCommenter := aTParseNodeOrNil.
+ ^previousValue!
Item was changed:
----- Method: CogARMCompiler>>genMulR:R: (in category 'abstract instructions') -----
genMulR: regSource R: regDest
"Use SMULL to produce a 64-bit result, explicitly in RISCTempReg,regDest.
By comparing RISCTempReg with regDest ASR 31(which effectively makes it 0 or -1) we know that the result being EQ means the hi reg and the top bit of the lo reg are the same - ie no overflow. The condition code can then be forced to oVerflow by use of MSR APSR_nzcvq, #1, lsl 28"
+ | first |
+ <var: 'first' type: #'AbstractInstruction *'>
+ first := cogit gen: SMULL operand: regSource operand: regDest. "result in RISCTempReg,regDest"
+ cogit gen: CMPSMULL operand: RISCTempReg operand: regDest.
+ cogit gen: MSR operand: 1.
+ ^first!
-
- cogit
- gen: SMULL operand: regSource operand: regDest; "result in RISCTempReg,regDest"
- gen: CMPSMULL operand: RISCTempReg operand: regDest;
- gen: MSR operand: 1!
Item was added:
+ ----- Method: CogAbstractInstruction>>genMulR:R: (in category 'abstract instructions') -----
+ genMulR: regSource R: regDest
+ "Generate whatever code necessary to do a bytesPerOop x bytesPerOop multiplication,
+ answering the first instruction uin the sequence."
+ <returnTypeC: #'AbstractInstruction *'>
+ self subclassResponsibility!
Item was changed:
----- Method: CogIA32Compiler>>genMulR:R: (in category 'abstract instructions') -----
genMulR: regSource R: regDest
+ ^cogit gen: IMULRR operand: regSource operand: regDest!
- cogit gen: IMULRR operand: regSource operand: regDest!
Item was changed:
----- Method: CogMIPSELCompiler>>genMulR:R: (in category 'abstract instructions') -----
genMulR: regSource R: regDest
+ ^cogit gen: MulRR operand: regSource operand: regDest!
- cogit gen: MulRR operand: regSource operand: regDest.
- ^0!
Item was changed:
----- Method: CogX64Compiler>>genMulR:R: (in category 'abstract instructions') -----
genMulR: regSource R: regDest
+ ^cogit gen: IMULRR operand: regSource operand: regDest!
- cogit gen: IMULRR operand: regSource operand: regDest!
Item was changed:
----- Method: CogX64Compiler>>isWithinMwOffsetRange: (in category 'testing') -----
isWithinMwOffsetRange: anAddress
"Answer if an address can be accessed using the offset in a MoveMw:r:R: or similar instruction.
We assume this is true for 32-bit processors and expect 64-bit processors to answer false
for values in the interpreter or the object memory. Restrict our use of offsets to reference
addresses within the method zone, rather than checking for a 32-bit offset, si as to keep the
simulator and real VM in sync."
+ ^cogit addressIsInCodeZone: anAddress!
- ^anAddress asUnsignedInteger < cogit methodZone zoneEnd!
Item was changed:
----- Method: Cogit>>MulR:R: (in category 'abstract instructions') -----
MulR: reg1 R: reg2
"Multiplication is a little weird on some processors. Defer to the backEnd
to allow it to generate any special code it may need to."
+ <inline: true>
+ ^backEnd genMulR: reg1 R: reg2!
- <returnTypeC: #'AbstractInstruction *'>
- <inline: false>
- backEnd genMulR: reg1 R: reg2.
- ^self abstractInstructionAt: opcodeIndex - 1!
Item was changed:
----- Method: Cogit>>addressIsInCodeZone: (in category 'testing') -----
addressIsInCodeZone: address
+ <inline: true>
- "N.B. We /don't/ write this as address between: codeBase and: methodZone limitZony in case we're
- testing an address in a method whose code has yet to be allocated and is hence >= methodZone limitZony"
^address asUnsignedInteger >= codeBase
+ and: [address < methodZone zoneEnd]!
- and: [address < methodZone youngReferrers]!
Item was changed:
----- Method: Cogit>>genGetLeafCallStackPointer (in category 'initialization') -----
genGetLeafCallStackPointer
"Generate a routine that answers the stack pointer immedately
after a leaf call, used for checking stack pointer alignment."
| startAddress |
<inline: false>
self allocateOpcodes: 32 bytecodes: 0.
- initialPC := 0.
- endPC := numAbstractOpcodes - 1.
startAddress := methodZoneBase.
backEnd genGetLeafCallStackPointerFunction.
self outputInstructionsForGeneratedRuntimeAt: startAddress.
self recordGeneratedRunTime: 'ceGetSP' address: startAddress.
+ ceGetSP := self cCoerceSimple: startAddress to: #'unsigned long (*)(void)'!
- ^startAddress!
Item was changed:
----- Method: Cogit>>generateCaptureCStackPointers: (in category 'initialization') -----
generateCaptureCStackPointers: captureFramePointer
"Generate the routine that writes the current values of the C frame and stack pointers into
variables. These are used to establish the C stack in trampolines back into the C run-time.
This is a presumptuous quick hack for x86. It is presumptuous for two reasons. Firstly
the system's frame and stack pointers may differ from those we use in generated code,
e.g. on register-rich RISCs. Secondly the ABI may not support a simple frameless call
as written here (for example 128-bit stack alignment on Mac OS X)."
| startAddress |
<inline: false>
self allocateOpcodes: 32 bytecodes: 0.
- initialPC := 0.
- endPC := numAbstractOpcodes - 1.
startAddress := methodZoneBase.
captureFramePointer ifTrue:
[self MoveR: FPReg Aw: self cFramePointerAddress].
"Capture the stack pointer prior to the call."
backEnd leafCallStackPointerDelta = 0
ifTrue: [self MoveR: SPReg Aw: self cStackPointerAddress]
ifFalse: [self MoveR: SPReg R: TempReg.
self AddCq: backEnd leafCallStackPointerDelta R: TempReg.
self MoveR: TempReg Aw: self cStackPointerAddress].
self RetN: 0.
self outputInstructionsForGeneratedRuntimeAt: startAddress.
processor flushICacheFrom: startAddress asUnsignedInteger to: methodZoneBase asUnsignedInteger.
self recordGeneratedRunTime: 'ceCaptureCStackPointers' address: startAddress.
ceCaptureCStackPointers := self cCoerceSimple: startAddress to: #'void (*)(void)'!
Item was changed:
----- Method: Cogit>>generateTrampolines (in category 'initialization') -----
generateTrampolines
"Generate the run-time entries and exits at the base of the native code zone and update the base.
Read the class-side method trampolines for documentation on the various trampolines"
| methodZoneStart |
methodZoneStart := methodZoneBase.
methodLabel address: methodZoneStart.
self allocateOpcodes: 80 bytecodes: 0.
- initialPC := 0.
- endPC := numAbstractOpcodes - 1.
hasYoungReferent := false.
objectRepresentation maybeGenerateSelectorIndexDereferenceRoutine.
self generateSendTrampolines.
self generateMissAbortTrampolines.
objectRepresentation generateObjectRepresentationTrampolines.
self generateRunTimeTrampolines.
NewspeakVM ifTrue: [self generateNewspeakRuntime].
SistaVM ifTrue: [self generateSistaRuntime].
self generateEnilopmarts.
self generateTracingTrampolines.
"finish up"
self recordGeneratedRunTime: 'methodZoneBase' address: methodZoneBase.
processor flushICacheFrom: methodZoneStart asUnsignedInteger to: methodZoneBase asUnsignedInteger!
Item was changed:
----- Method: Cogit>>generateVMOwnerLockFunctions (in category 'initialization') -----
generateVMOwnerLockFunctions
| startAddress |
+ <inline: true>
- <inline: false>
self cppIf: COGMTVM
ifTrue:
[self allocateOpcodes: backEnd numLowLevelLockOpcodes bytecodes: 0.
self zeroOpcodeIndex.
- initialPC := 0.
- endPC := numAbstractOpcodes - 1.
startAddress := methodZoneBase.
backEnd generateLowLevelTryLock: coInterpreter vmOwnerLockAddress.
self outputInstructionsForGeneratedRuntimeAt: startAddress.
self recordGeneratedRunTime: 'ceTryLockVMOwner' address: startAddress.
ceTryLockVMOwner := self cCoerceSimple: startAddress to: #'unsigned long (*)(void)'.
self zeroOpcodeIndex.
initialPC := 0.
endPC := numAbstractOpcodes - 1.
startAddress := methodZoneBase.
backEnd generateLowLevelUnlock: coInterpreter vmOwnerLockAddress.
self outputInstructionsForGeneratedRuntimeAt: startAddress.
self recordGeneratedRunTime: 'ceUnlockVMOwner' address: startAddress.
ceUnlockVMOwner := self cCoerceSimple: startAddress to: #'void (*)(void)']!
Item was changed:
----- Method: Cogit>>handleWriteSimulationTrap: (in category 'simulation only') -----
handleWriteSimulationTrap: aProcessorSimulationTrap
<doNotGenerate>
| variableValue |
+ (self addressIsInCodeZone: aProcessorSimulationTrap address) ifTrue:
- (aProcessorSimulationTrap address between: codeBase and: methodZone zoneEnd) ifTrue:
[self error: 'attempt to write to code space'].
variableValue := processor perform: aProcessorSimulationTrap registerAccessor.
(simulatedVariableSetters at: aProcessorSimulationTrap address) value: variableValue.
processor pc: aProcessorSimulationTrap nextpc!
Item was changed:
----- Method: Cogit>>initializeCodeZoneFrom:upTo: (in category 'initialization') -----
initializeCodeZoneFrom: startAddress upTo: endAddress
<api>
self initializeBackend.
backEnd stopsFrom: startAddress to: endAddress - 1.
self cCode: [self sqMakeMemoryExecutableFrom: startAddress To: endAddress]
inSmalltalk: [self initializeProcessor].
codeBase := methodZoneBase := startAddress.
minValidCallAddress := (codeBase min: coInterpreter interpretAddress)
min: coInterpreter primitiveFailAddress.
methodZone manageFrom: methodZoneBase to: endAddress.
self maybeGenerateCheckFeatures.
self maybeGenerateICacheFlush.
self generateVMOwnerLockFunctions.
+ self genGetLeafCallStackPointer.
- ceGetSP := self cCoerceSimple: self genGetLeafCallStackPointer to: #'unsigned long (*)(void)'.
self generateStackPointerCapture.
self generateTrampolines.
self computeEntryOffsets.
self generateClosedPICPrototype.
+ "repeat so that now the methodZone ignores the generated run-time"
methodZone manageFrom: methodZoneBase to: endAddress.
"N.B. this is assumed to be the last thing done in initialization; see Cogit>>initialized"
self generateOpenPICPrototype!
Item was changed:
----- Method: Cogit>>maybeGenerateCheckFeatures (in category 'initialization') -----
maybeGenerateCheckFeatures
| startAddress |
+ <inline: true>
+ backEnd numCheckFeaturesOpcodes > 0 ifTrue:
+ [self allocateOpcodes: backEnd numCheckFeaturesOpcodes bytecodes: 0.
+ startAddress := methodZoneBase.
+ backEnd generateCheckFeatures.
+ self outputInstructionsForGeneratedRuntimeAt: startAddress.
+ self recordGeneratedRunTime: 'ceCheckFeaturesFunction' address: startAddress.
+ ceCheckFeaturesFunction := self cCoerceSimple: startAddress to: #'unsigned long (*)(void)']!
- <inline: false>
- backEnd numCheckFeaturesOpcodes = 0 ifTrue:
- [^nil].
- self allocateOpcodes: backEnd numCheckFeaturesOpcodes bytecodes: 0.
- initialPC := 0.
- endPC := numAbstractOpcodes - 1.
- startAddress := methodZoneBase.
- backEnd generateCheckFeatures.
- self outputInstructionsForGeneratedRuntimeAt: startAddress.
- self recordGeneratedRunTime: 'ceCheckFeaturesFunction' address: startAddress.
- ceCheckFeaturesFunction := self cCoerceSimple: startAddress to: #'unsigned long (*)(void)'!
Item was changed:
----- Method: Cogit>>maybeGenerateICacheFlush (in category 'initialization') -----
maybeGenerateICacheFlush
| startAddress |
+ <inline: true>
+ backEnd numICacheFlushOpcodes > 0 ifTrue:
+ [self allocateOpcodes: backEnd numICacheFlushOpcodes bytecodes: 0.
+ startAddress := methodZoneBase.
+ backEnd generateICacheFlush.
+ self outputInstructionsForGeneratedRuntimeAt: startAddress.
+ self recordGeneratedRunTime: 'ceFlushICache' address: startAddress.
+ ceFlushICache := self cCoerceSimple: startAddress to: #'void (*)(unsigned long,unsigned long)']!
- <inline: false>
- backEnd numICacheFlushOpcodes = 0 ifTrue:
- [^nil].
- self allocateOpcodes: backEnd numICacheFlushOpcodes bytecodes: 0.
- initialPC := 0.
- endPC := numAbstractOpcodes - 1.
- startAddress := methodZoneBase.
- backEnd generateICacheFlush.
- self outputInstructionsForGeneratedRuntimeAt: startAddress.
- self recordGeneratedRunTime: 'ceFlushICache' address: startAddress.
- ceFlushICache := self cCoerceSimple: startAddress to: #'void (*)(unsigned long,unsigned long)'!
Item was changed:
----- Method: Spur32BitMemoryManager>>instantiateClass:indexableSize: (in category 'instantiation') -----
instantiateClass: classObj indexableSize: nElements
+ <api>
<var: #nElements type: #usqInt>
"Allocate an instance of a variable class, excepting CompiledMethod."
| instSpec classFormat numSlots classIndex newObj fillValue |
classFormat := self formatOfClass: classObj.
instSpec := self instSpecOfClassFormat: classFormat.
classIndex := self rawHashBitsOf: classObj.
fillValue := 0.
instSpec caseOf: {
[self arrayFormat] ->
[numSlots := nElements.
fillValue := nilObj].
[self indexablePointersFormat] ->
[numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements.
fillValue := nilObj].
[self weakArrayFormat] ->
[numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements.
fillValue := nilObj].
[self sixtyFourBitIndexableFormat] ->
[nElements > (self maxSlotsForAlloc / 2) ifTrue:
[coInterpreter primitiveFailFor: PrimErrUnsupported.
^nil].
numSlots := nElements * 2].
[self firstLongFormat] ->
[(classIndex = ClassFloatCompactIndex and: [nElements ~= 2]) ifTrue:
[coInterpreter primitiveFailFor: PrimErrBadReceiver.
^nil].
numSlots := nElements].
[self firstShortFormat] ->
[numSlots := nElements + 1 // 2.
instSpec := instSpec + (nElements bitAnd: 1)].
[self firstByteFormat] ->
[numSlots := nElements + 3 // 4.
instSpec := instSpec + (4 - nElements bitAnd: 3)] }
otherwise: ["some Squeak images include funky fixed subclasses of abstract variable
superclasses. e.g. DirectoryEntry as a subclass of ArrayedCollection.
Allow fixed classes to be instantiated here iff nElements = 0."
(nElements ~= 0 or: [instSpec > self lastPointerFormat]) ifTrue:
[^nil].
numSlots := self fixedFieldsOfClassFormat: classFormat]. "non-indexable"
classIndex = 0 ifTrue:
[classIndex := self ensureBehaviorHash: classObj.
classIndex < 0 ifTrue:
[coInterpreter primitiveFailFor: classIndex negated.
^nil]].
numSlots > self maxSlotsForNewSpaceAlloc
ifTrue:
[numSlots > self maxSlotsForAlloc ifTrue:
[coInterpreter primitiveFailFor: PrimErrUnsupported.
^nil].
newObj := self allocateSlotsInOldSpace: numSlots format: instSpec classIndex: classIndex]
ifFalse:
[newObj := self allocateSlots: numSlots format: instSpec classIndex: classIndex].
newObj ifNotNil:
[self fillObj: newObj numSlots: numSlots with: fillValue].
^newObj!
Item was changed:
----- Method: Spur64BitMemoryManager>>instantiateClass:indexableSize: (in category 'instantiation') -----
instantiateClass: classObj indexableSize: nElements
+ <api>
<var: #nElements type: #usqInt>
"Allocate an instance of a variable class, excepting CompiledMethod."
| instSpec classFormat numSlots classIndex newObj fillValue |
classFormat := self formatOfClass: classObj.
instSpec := self instSpecOfClassFormat: classFormat.
classIndex := self rawHashBitsOf: classObj.
fillValue := 0.
instSpec caseOf: {
[self arrayFormat] ->
[numSlots := nElements.
fillValue := nilObj].
[self indexablePointersFormat] ->
[numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements.
fillValue := nilObj].
[self weakArrayFormat] ->
[numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements.
fillValue := nilObj].
[self sixtyFourBitIndexableFormat] ->
[numSlots := nElements].
[self firstLongFormat] ->
[(classIndex = ClassFloatCompactIndex and: [nElements ~= 2]) ifTrue:
[coInterpreter primitiveFailFor: PrimErrBadReceiver.
^nil].
numSlots := nElements + 1 // 2.
instSpec := instSpec + (nElements bitAnd: 1)].
[self firstShortFormat] ->
[numSlots := nElements + 3 // 4.
instSpec := instSpec + (4 - nElements bitAnd: 3)].
[self firstByteFormat] ->
[numSlots := nElements + 7 // 8.
instSpec := instSpec + (8 - nElements bitAnd: 7)] }
otherwise: ["some Squeak images include funky fixed subclasses of abstract variable
superclasses. e.g. DirectoryEntry as a subclass of ArrayedCollection.
Allow fixed classes to be instantiated here iff nElements = 0."
(nElements ~= 0 or: [instSpec > self lastPointerFormat]) ifTrue:
[^nil].
numSlots := self fixedFieldsOfClassFormat: classFormat]. "non-indexable"
classIndex = 0 ifTrue:
[classIndex := self ensureBehaviorHash: classObj.
classIndex < 0 ifTrue:
[coInterpreter primitiveFailFor: classIndex negated.
^nil]].
numSlots > self maxSlotsForNewSpaceAlloc
ifTrue:
[numSlots > self maxSlotsForAlloc ifTrue:
[coInterpreter primitiveFailFor: PrimErrUnsupported.
^nil].
newObj := self allocateSlotsInOldSpace: numSlots format: instSpec classIndex: classIndex]
ifFalse:
[newObj := self allocateSlots: numSlots format: instSpec classIndex: classIndex].
newObj ifNotNil:
[self fillObj: newObj numSlots: numSlots with: fillValue].
^newObj!
Item was changed:
----- Method: SpurMemoryManager>>falseObject (in category 'accessing') -----
falseObject
+ <api>
^falseObj!
Item was changed:
----- Method: SpurMemoryManager>>fetchPointer:ofObject: (in category 'object access') -----
fetchPointer: fieldIndex ofObject: objOop
+ <api>
^self longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)!
Item was changed:
----- Method: SpurMemoryManager>>nilObject (in category 'accessing') -----
nilObject
+ <api>
^nilObj!
Item was changed:
----- Method: SpurMemoryManager>>trueObject (in category 'accessing') -----
trueObject
+ <api>
^trueObj!
Item was changed:
----- Method: StackInterpreter>>positive64BitIntegerFor: (in category 'primitive support') -----
positive64BitIntegerFor: integerValue
+ <api>
<var: 'integerValue' type: #sqLong>
"Answer a Large Positive Integer object for the given integer value. N.B. will *not* cause a GC."
| newLargeInteger highWord sz |
objectMemory hasSixtyFourBitImmediates
ifTrue:
[(integerValue >= 0 and: [objectMemory isIntegerValue: integerValue]) ifTrue:
[^objectMemory integerObjectOf: integerValue].
sz := 8]
ifFalse:
[(highWord := integerValue >>> 32) = 0 ifTrue:
[^self positive32BitIntegerFor: integerValue].
sz := 5.
(highWord := highWord >> 8) = 0 ifFalse:
[sz := sz + 1.
(highWord := highWord >> 8) = 0 ifFalse:
[sz := sz + 1.
(highWord := highWord >> 8) = 0 ifFalse:[sz := sz + 1]]]].
newLargeInteger := objectMemory
eeInstantiateSmallClassIndex: ClassLargePositiveIntegerCompactIndex
format: (objectMemory byteFormatForNumBytes: sz)
numSlots: 8 / objectMemory bytesPerOop.
self cppIf: VMBIGENDIAN
ifTrue:
[objectMemory
storeByte: 7 ofObject: newLargeInteger withValue: (integerValue >> 56 bitAnd: 16rFF);
storeByte: 6 ofObject: newLargeInteger withValue: (integerValue >> 48 bitAnd: 16rFF);
storeByte: 5 ofObject: newLargeInteger withValue: (integerValue >> 40 bitAnd: 16rFF);
storeByte: 4 ofObject: newLargeInteger withValue: (integerValue >> 32 bitAnd: 16rFF);
storeByte: 3 ofObject: newLargeInteger withValue: (integerValue >> 24 bitAnd: 16rFF);
storeByte: 2 ofObject: newLargeInteger withValue: (integerValue >> 16 bitAnd: 16rFF);
storeByte: 1 ofObject: newLargeInteger withValue: (integerValue >> 8 bitAnd: 16rFF);
storeByte: 0 ofObject: newLargeInteger withValue: (integerValue ">> 0" bitAnd: 16rFF)]
ifFalse:
[objectMemory storeLong64: 0 ofObject: newLargeInteger withValue: integerValue].
^newLargeInteger
!
Item was changed:
----- Method: TLabeledCommentNode>>emitCCodeOn:level:generator: (in category 'C code generation') -----
emitCCodeOn: aStream level: level generator: aCodeGen
"Emit a C comment with optional label."
self printOptionalLabelOn: aStream.
comment ifNotNil:
+ [(aCodeGen previousCommentMarksInlining: (label isNil and: [asmLabel isNil and: [comment beginsWith: 'begin ']])) ifTrue:
+ [^true].
+ aStream nextPutAll: '/* '; nextPutAll: comment; nextPutAll: ' */'.
+ aCodeGen previousCommenter: self].
- [aStream nextPutAll: '/* '.
- aStream nextPutAll: comment.
- aStream nextPutAll: ' */'].
(asmLabel notNil "only output labels in the interpret function."
and: [aCodeGen currentMethod selector == #interpret]) ifTrue:
[aStream crtab: level.
aCodeGen outputAsmLabel: asmLabel on: aStream]!
Item was added:
+ ----- Method: TLabeledCommentNode>>emitCCommentOn:level:generator: (in category 'C code generation') -----
+ emitCCommentOn: aStream level: level generator: aCodeGen
+ "Override to avoid outputting comments since this is done explicitly in statement lists."!
Item was removed:
- ----- Method: TParseNode>>emitCCommentOn:level: (in category 'C code generation') -----
- emitCCommentOn: aStream level: level
- "Emit the transferred Smalltalk comments as C comments."
-
- comment ifNotNil:
- [comment isString ifTrue: [^self]. "safety catch"
- aStream cr.
- 1 to: comment size do: [:index |
- aStream tab: level; nextPutAll: '/* '.
- ((comment at: index) findTokens: Character cr)
- do: [:line| aStream nextPutAll: line withBlanksTrimmed]
- separatedBy: [aStream crtab: level; next: 3 put: Character space].
- aStream nextPutAll: ' */'; cr].
- aStream cr]!
Item was added:
+ ----- Method: TParseNode>>emitCCommentOn:level:generator: (in category 'C code generation') -----
+ emitCCommentOn: aStream level: level generator: aCodeGen
+ "Emit the transferred Smalltalk comments as C comments."
+
+ ((aCodeGen previousCommenter: self) == self or: [comment isNil]) ifTrue:
+ [aCodeGen previousCommentMarksInlining: false.
+ ^self].
+ comment withIndexDo:
+ [:commentString :index |
+ (index = 1 and: [commentString beginsWith: 'begin ']) ifTrue:
+ [(aCodeGen previousCommentMarksInlining: true) ifTrue: [^true]].
+ aStream crtab: level; nextPutAll: '/* '.
+ ((comment at: index) findTokens: Character cr)
+ do: [:line| aStream nextPutAll: line withBlanksTrimmed]
+ separatedBy: [aStream crtab: level; next: 3 put: Character space].
+ aStream nextPutAll: ' */'].
+ aStream cr!
Item was changed:
----- Method: TStmtListNode>>emitCCodeAsArgumentOn:level:generator: (in category 'C code generation') -----
emitCCodeAsArgumentOn: aStream level: level generator: aCodeGen
| size |
(size := statements size) = 1 ifTrue:
[^statements first emitCCodeAsArgumentOn: aStream level: level generator: aCodeGen].
aStream nextPut: $(. "N.B. Comma binds weakest of all C operators."
statements withIndexDo:
[:s :idx| | p1 p2 |
p1 := aStream position.
+ s emitCCommentOn: aStream level: level generator: aCodeGen.
- s emitCCommentOn: aStream level: level.
(s isLeaf and: [s isLabel not and: [idx < statements size]]) ifFalse:
[s emitCCodeAsArgumentOn: aStream level: level + 1 generator: aCodeGen].
p2 := aStream position.
(idx < size and: [p2 > p1]) ifTrue:
[((self endsWithCloseBracket: aStream)
or: [s isComment]) ifFalse: [aStream nextPut: $,].
aStream crtab: level]].
aStream nextPut: $)!
Item was changed:
----- Method: TStmtListNode>>emitCCodeOn:prependToEnd:level:generator: (in category 'C code generation') -----
emitCCodeOn: aStream prependToEnd: aNodeOrNil level: level generator: aCodeGen
+ self emitCCommentOn: aStream level: level generator: aCodeGen.
- self emitCCommentOn: aStream level: level.
statements withIndexDo:
+ [:s :idx| | position |
+ s emitCCommentOn: aStream level: level generator: aCodeGen.
- [:s :idx|
- s isStmtList ifFalse:
- [s emitCCommentOn: aStream level: level].
(s isLeaf and: [s isLabel not and: [aNodeOrNil isNil or: [idx < statements size]]]) ifFalse:
[aStream peekLast ~~ Character tab ifTrue:
[aStream tab: level].
+ position := aStream position.
(aNodeOrNil notNil
and: [idx = statements size])
ifTrue:
[s emitCCodeOn: aStream prependToEnd: aNodeOrNil level: level generator: aCodeGen]
ifFalse:
[s emitCCodeOn: aStream level: level generator: aCodeGen].
+ aStream position > position ifTrue:
+ [(self stream: aStream endsWithAnyOf: '};') ifFalse:
+ [s needsTrailingSemicolon ifTrue:
+ [aStream nextPut: $;]].
+ aStream peekLast ~~ Character cr ifTrue:
+ [aStream cr]]]]!
- (self stream: aStream endsWithAnyOf: '};') ifFalse:
- [s needsTrailingSemicolon ifTrue:
- [aStream nextPut: $;]].
- aStream peekLast ~~ Character cr ifTrue:
- [aStream cr]]].
- !
More information about the Vm-dev
mailing list