- Fixing the merge to use unsignedLongAt: in the stack pages.

- Fixing WordSizeParameters
hernanmd · Oct 3, 2022 · 563039d · 563039d
1 parent f6e1c3f
commit 563039d
Show file tree

Hide file tree

Showing 28 changed files with 353 additions and 387 deletions.
diff --git a/smalltalksrc/Melchor/VMClass.class.st b/smalltalksrc/Melchor/VMClass.class.st
@@ -1278,6 +1278,20 @@ VMClass >> unreachable [
 	self error: 'UNREACHABLE'
 ]
 
+{ #category : #'memory access' }
+VMClass >> unsignedLong32At: anInteger [
+
+	<inline: #always>
+	^ self uint32AtPointer: anInteger
+]
+
+{ #category : #'memory access' }
+VMClass >> unsignedLong32At: anInteger put: aValue [
+
+	<inline: #always>
+	^ self uint32AtPointer: anInteger put: aValue
+]
+
 { #category : #'memory access' }
 VMClass >> unsignedLong64At: anInteger [
 

diff --git a/smalltalksrc/Slang/CArray.class.st b/smalltalksrc/Slang/CArray.class.st
@@ -8,7 +8,8 @@ Class {
 		'interpreter',
 		'arrayBaseAddress',
 		'ptrOffset',
-		'unitSize'
+		'unitSize',
+		'unsigned'
 	],
 	#category : #'Slang-Types'
 }
@@ -92,6 +93,18 @@ CArray >> asSingleFloatAccessor [
 CArray >> at: offset [
 	| address |
 	address := unitSize * offset + self ptrAddress.
+
+	unsigned ifTrue: [ 
+			^unitSize <= 2
+				ifTrue:
+					[unitSize = 1
+						ifTrue: [interpreter unsignedByteAt: address]
+						ifFalse: [interpreter unsignedShortAt: address]]
+				ifFalse:
+					[unitSize = 4
+						ifTrue: [interpreter unsignedLong32At: address]
+						ifFalse: [interpreter unsignedLong64At: address]]].
+
 	^unitSize <= 2
 		ifTrue:
 			[unitSize = 1
@@ -107,6 +120,18 @@ CArray >> at: offset [
 CArray >> at: offset put: val [
 	| address |
 	address := unitSize * offset + self ptrAddress.
+
+	unsigned ifTrue: 
+		[	^unitSize <= 2
+				ifTrue:
+					[unitSize = 1
+						ifTrue: [interpreter unsignedByteAt: address put: val]
+						ifFalse: [interpreter unsignedShortAt: address put: val]]
+				ifFalse:
+					[unitSize = 4
+						ifTrue: [interpreter unsignedLong32At: address put: val]
+						ifFalse: [interpreter unsignedLong64At: address put: val]]].
+
 	^unitSize <= 2
 		ifTrue:
 			[unitSize = 1
@@ -118,6 +143,12 @@ CArray >> at: offset put: val [
 				ifFalse: [interpreter long64At: address put: val]]
 ]
 
+{ #category : #'as yet unclassified' }
+CArray >> beUnsigned [
+
+	unsigned := true.
+]
+
 { #category : #accessing }
 CArray >> cPtrAsOop [
 	ptrOffset = 0 ifFalse: [self error: 'offset must be zero'].
@@ -131,6 +162,7 @@ CArray >> coerceTo: cTypeString sim: interpreterSimulator [
 		['int']				-> [self ptrAddress].
 		['float *']			-> [self asSingleFloatAccessor].
 		['double *']			-> [self asDoubleFloatAccessor].
+		['usqInt *']			-> [self shallowCopy beUnsigned; unitSize: interpreter bytesPerOop; yourself].
 		['sqInt *']			-> [self shallowCopy unitSize: interpreter bytesPerOop; yourself].
 		['unsigned int *']	-> [self shallowCopy unitSize: 4; yourself].
 		['int *']				-> [self shallowCopy unitSize: 4; yourself].
@@ -165,6 +197,13 @@ CArray >> hash [
 	^interpreter hash bitXor: arrayBaseAddress + ptrOffset + unitSize
 ]
 
+{ #category : #initialization }
+CArray >> initialize [ 
+
+	super initialize.
+	unsigned := false
+]
+
 { #category : #accessing }
 CArray >> intAt: index [
 	^ (self at: index) signedIntFromLong
@@ -181,6 +220,7 @@ CArray >> interpreter: interpreterSimulator address: arrayAddress unitSize: numB
 	interpreter := interpreterSimulator.
 	arrayBaseAddress := arrayAddress.
 	self unitSize: numBytes.
+	unsigned := false.
 	ptrOffset := 0
 ]
 

diff --git a/smalltalksrc/Slang/SlangMemoryManager.class.st b/smalltalksrc/Slang/SlangMemoryManager.class.st
@@ -63,6 +63,20 @@ SlangMemoryManager >> copyFrom: start to: end [
 		to: end - region start + 1
 ]
 
+{ #category : #allocating }
+SlangMemoryManager >> findHoleBiggerThan: desiredSize from: desiredPosition [
+
+	| foundPosition |
+	self assert: desiredSize >= self pageSize.
+
+	foundPosition := desiredPosition.
+
+	[ self wholeAt: foundPosition fits: desiredSize  ] 
+		whileFalse: [ foundPosition := foundPosition + desiredSize ].
+
+	^ foundPosition
+]
+
 { #category : #'memory-access' }
 SlangMemoryManager >> float32At: address [ 
 
@@ -123,20 +137,6 @@ SlangMemoryManager >> float64At: address put: value [
 		put: value
 ]
 
-{ #category : #allocating }
-SlangMemoryManager >> findHoleBiggerThan: desiredSize from: desiredPosition [
-
-	| foundPosition |
-	self assert: desiredSize >= self pageSize.
-
-	foundPosition := desiredPosition.
-
-	[ self wholeAt: foundPosition fits: desiredSize  ] 
-		whileFalse: [ foundPosition := foundPosition + desiredSize ].
-
-	^ foundPosition
-]
-
 { #category : #allocating }
 SlangMemoryManager >> free: address [