Skip to content
Closed
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
14 changes: 7 additions & 7 deletions smalltalksrc/VMMaker/CogX64Compiler.class.st
Original file line number Diff line number Diff line change
Expand Up @@ -433,6 +433,13 @@ CogX64Compiler >> canZeroExtend [
^true
]

{ #category : 'testing' }
CogX64Compiler >> checkIs32bit: offset [

(offset between: -2147483648 and: 2147483647) ifFalse: [
self error: 'Cannot jump to distances larger than 32 bits' ]
]

{ #category : 'accessing' }
CogX64Compiler >> cmpC32RTempByteSize [
^5
Expand Down Expand Up @@ -4276,13 +4283,6 @@ CogX64Compiler >> is32BitSignedImmediate: a64BitUnsignedOperand [
inSmalltalk: [((a64BitUnsignedOperand >> 32) signedIntFromLong + 1 bitXor: 1) = (a64BitUnsignedOperand >> 31 bitAnd: 1)]
]

{ #category : 'testing' }
CogX64Compiler >> checkIs32bit: offset [

(offset between: -2147483648 and: 2147483647) ifFalse: [
self error: 'Cannot jump to distances larger than 32 bits' ]
]

{ #category : 'testing' }
CogX64Compiler >> isAddressRelativeToVarBase: varAddress [
"Support for addressing variables off the dedicated VarBaseReg. Allow for 1Mb of variables.
Expand Down
8 changes: 0 additions & 8 deletions smalltalksrc/VMMaker/Spur64BitMMLESimulator.class.st
Original file line number Diff line number Diff line change
Expand Up @@ -85,14 +85,6 @@ Spur64BitMMLESimulator >> fetchFloatAt: floatBitsAddress into: aFloat [
aFloat at: 1 put: (self uint32AtPointer: floatBitsAddress+4)
]

{ #category : 'as yet unclassified' }
Spur64BitMMLESimulator >> fetchPointer: fieldIndex ofObject: objOop [
self assert: (self isForwarded: objOop) not.
self assert: (fieldIndex >= 0 and: [fieldIndex < (self numSlotsOfAny: objOop)
or: [fieldIndex = 0 "forwarders"]]).
^super fetchPointer: fieldIndex ofObject: objOop
]

{ #category : 'spur bootstrap' }
Spur64BitMMLESimulator >> freeLists [
^freeLists
Expand Down
8 changes: 8 additions & 0 deletions smalltalksrc/VMMaker/VMStackPages.class.st
Original file line number Diff line number Diff line change
Expand Up @@ -566,6 +566,14 @@ VMStackPages >> surrogateAtAddress: anAddress [
^pageMap at: anAddress
]

{ #category : 'memory access' }
VMStackPages >> uint8At: pointer [
<doNotGenerate>
"Read an unsigned 8-bit value from memory."
self assert: (pointer >= minStackAddress and: [pointer < maxStackAddress]).
^objectMemory byteAt: pointer
]
Comment on lines +570 to +575
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@Sneharaj7645653 thanks for start working on this!

There is some work needed here yet.

  • The method should be defined in VMClass and not in VMStackPages. Changing the Stack API access should be a separate issue, that I advice we attack later :)
  • we should rewrite some users to use it instead of the old version byteAt:. Check the senders of byteAt: within the VMMaker package (you can use the filter in the bottom of the list). I see at least 72 of them ;).
  • Also, we should probably remove the redefinitions of byteAt: in all the simulator subclasses classes. (Check subclasses of SpurMemoryManager)
  • Finally, you should run some tests to check if you missed some code.

Copy link
Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Sure, I will get the changes done.


{ #category : 'memory access' }
VMStackPages >> unsignedLongAt: anInteger [

Expand Down