VM Maker: Cog-eem.409.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
1 message Options
Reply | Threaded
Open this post in threaded view
|

VM Maker: Cog-eem.409.mcz

commits-2
 
Eliot Miranda uploaded a new version of Cog to project VM Maker:
http://source.squeak.org/VMMaker/Cog-eem.409.mcz

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

Name: Cog-eem.409
Author: eem
Time: 14 September 2020, 5:11:03.609816 pm
UUID: 12f864b3-51e2-4d9b-a0e1-380233c6a563
Ancestors: Cog-eem.408

Make MIPSEL simulate a bit more (the things we do when trying to avoid hard work...)

=============== Diff against Cog-eem.408 ===============

Item was added:
+ ----- Method: MIPSELSimulator class>>wordSize (in category 'accessing') -----
+ wordSize
+ ^4!

Item was changed:
+ ----- Method: MIPSSimulator>>a0 (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>a0 (in category 'registers') -----
  a0
  ^self unsignedRegister: A0!

Item was changed:
+ ----- Method: MIPSSimulator>>a0: (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>a0: (in category 'registers') -----
  a0: anInteger
  ^self unsignedRegister: A0 put: anInteger!

Item was changed:
+ ----- Method: MIPSSimulator>>a1 (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>a1 (in category 'registers') -----
  a1
  ^self unsignedRegister: A1!

Item was changed:
+ ----- Method: MIPSSimulator>>a1: (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>a1: (in category 'registers') -----
  a1: anInteger
  ^self unsignedRegister: A1 put: anInteger!

Item was changed:
+ ----- Method: MIPSSimulator>>a2 (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>a2 (in category 'registers') -----
  a2
  ^self unsignedRegister: A2!

Item was changed:
+ ----- Method: MIPSSimulator>>a2: (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>a2: (in category 'registers') -----
  a2: anInteger
  ^self unsignedRegister: A2 put: anInteger!

Item was changed:
+ ----- Method: MIPSSimulator>>a3 (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>a3 (in category 'registers') -----
  a3
  ^self unsignedRegister: A3!

Item was changed:
+ ----- Method: MIPSSimulator>>a3: (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>a3: (in category 'registers') -----
  a3: anInteger
  ^self unsignedRegister: A3 put: anInteger!

Item was added:
+ ----- Method: MIPSSimulator>>at (in category 'accessing-registers') -----
+ at
+ ^self unsignedRegister: AT!

Item was added:
+ ----- Method: MIPSSimulator>>attemptJumpTo:type: (in category 'instructions - control') -----
+ attemptJumpTo: nextPC type: trapType
+ (nextPC between: readableBase and: exectuableLimit) ifFalse:
+ [^(ProcessorSimulationTrap
+ pc: pc
+ nextpc: pc + OneInstruction
+ address: nextPC
+ type: trapType)
+ signal].
+ pc := nextPC - OneInstruction "Account for general increment"!

Item was added:
+ ----- Method: MIPSSimulator>>controlRegisterGetters (in category 'accessing-abstract') -----
+ controlRegisterGetters
+ ^#(pc)!

Item was added:
+ ----- Method: MIPSSimulator>>decorateDisassembly:for:fromAddress: (in category 'disassembly') -----
+ decorateDisassembly: anInstructionString for: aSymbolManager "<Cogit>" fromAddress: address
+ "for now..."
+ ^anInstructionString!

Item was changed:
  ----- Method: MIPSSimulator>>disassembleInstructionAt:In: (in category 'disassembly') -----
  disassembleInstructionAt: index In: memory
  ^String streamContents:
+ [:aStream| | word |
- [:aStream| | instruction word |
  word := memory unsignedLongAt: index + 1.
+ "word printOn: aStream base: 16 nDigits: 8."
+ index printOn: aStream base: 16 nDigits: 6.
+ aStream nextPut: $:; space.
+ aStream nextPutAll: ((MIPSInstruction new value: word) decodeFor: MIPSDisassembler new)]!
- word printOn: aStream base: 16 nDigits: 8.
- aStream space; space.
- instruction := MIPSInstruction new value: word.
- aStream nextPutAll: (instruction decodeFor: MIPSDisassembler new)]!

Item was added:
+ ----- Method: MIPSSimulator>>disassembleNextInstructionIn:for: (in category 'disassembly') -----
+ disassembleNextInstructionIn: memory for: aSymbolManager "<Cogit|nil>"
+ | instruction |
+ pc >= memory size ifTrue:
+ [| string |
+ string := aSymbolManager ifNotNil:
+ [aSymbolManager lookupAddress: pc].
+ ^self pc hex, ' : ', (string ifNil: ['Invalid address'])].
+ instruction := self disassembleInstructionAt: self pc In: memory.
+ ^aSymbolManager
+ ifNil: [instruction]
+ ifNotNil: [self decorateDisassembly: instruction for: aSymbolManager fromAddress: pc]!

Item was changed:
+ ----- Method: MIPSSimulator>>fp (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>fp (in category 'registers') -----
  fp
  ^self unsignedRegister: FP!

Item was changed:
+ ----- Method: MIPSSimulator>>fp: (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>fp: (in category 'registers') -----
  fp: anInteger
  ^self unsignedRegister: FP put: anInteger!

Item was changed:
+ ----- Method: MIPSSimulator>>getterForRegister: (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>getterForRegister: (in category 'registers') -----
  getterForRegister: registerNumber
  ^#(zr at v0 v1 a0 a1 a2 a3
  t0 t1 t2 t3 t4 t5 t6 t7
  s0 s1 s2 s3 s4 s5 s6 s7
  t8 t9 k0 k1 gp sp fp ra) at: registerNumber + 1!

Item was changed:
+ ----- Method: MIPSSimulator>>gp (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>gp (in category 'registers') -----
  gp
  ^self unsignedRegister: GP!

Item was changed:
+ ----- Method: MIPSSimulator>>gp: (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>gp: (in category 'registers') -----
  gp: anInteger
  ^self unsignedRegister: GP put: anInteger!

Item was changed:
  ----- Method: MIPSSimulator>>jump: (in category 'instructions - control') -----
  jump: instruction
  | nextPC |
  self assert: inDelaySlot not.
  jumpingPC := pc.
  pc := pc + OneInstruction.
  nextPC := (pc bitAnd: 16rF0000000) + (instruction target << 2). "Region is that of the delay slot."
  self executeDelaySlot.
+ self attemptJumpTo: nextPC type: #jump!
- pc := nextPC - OneInstruction. "Account for general increment"!

Item was changed:
  ----- Method: MIPSSimulator>>jumpAndLink: (in category 'instructions - control') -----
  jumpAndLink: instruction
  | nextPC |
  self assert: inDelaySlot not.
  self unsignedRegister: RA put: pc + TwoInstructions. "Return past delay slot."
  jumpingPC := pc.
  pc := pc + OneInstruction.
  nextPC := (pc bitAnd: 16rF0000000) + (instruction target << 2). "Region is that of the delay slot."
  self executeDelaySlot.
+ self attemptJumpTo: nextPC type: #call!
- pc := nextPC - OneInstruction. "Account for general increment"!

Item was changed:
  ----- Method: MIPSSimulator>>jumpAndLinkRegister: (in category 'instructions - control') -----
  jumpAndLinkRegister: instruction
  | nextPC |
  self assert: inDelaySlot not.
  self unsignedRegister: instruction rd put: pc + TwoInstructions. "Return past delay slot."
  nextPC := self unsignedRegister: instruction rs.
  jumpingPC := pc.
  pc := pc + OneInstruction.
  self executeDelaySlot.
+ self attemptJumpTo: nextPC type: #call!
- pc := nextPC.
- pc := pc - OneInstruction. "Account for general increment"!

Item was changed:
  ----- Method: MIPSSimulator>>jumpRegister: (in category 'instructions - control') -----
  jumpRegister: instruction
  | nextPC |
  self assert: inDelaySlot not.
  nextPC := self unsignedRegister: instruction rs.
  jumpingPC := pc.
  pc := pc + OneInstruction.
  self executeDelaySlot.
+ self attemptJumpTo: nextPC type: (instruction rs == RA ifTrue: [#return] ifFalse: [#jump])!
- pc := nextPC.
- pc := pc - OneInstruction. "Account for general increment"!

Item was changed:
+ ----- Method: MIPSSimulator>>k0 (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>k0 (in category 'registers') -----
  k0
  ^self unsignedRegister: K0!

Item was changed:
+ ----- Method: MIPSSimulator>>k0: (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>k0: (in category 'registers') -----
  k0: anInteger
  ^self unsignedRegister: K0 put: anInteger!

Item was changed:
+ ----- Method: MIPSSimulator>>k1 (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>k1 (in category 'registers') -----
  k1
  ^self unsignedRegister: K1!

Item was changed:
+ ----- Method: MIPSSimulator>>k1: (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>k1: (in category 'registers') -----
  k1: anInteger
  ^self unsignedRegister: K1 put: anInteger!

Item was added:
+ ----- Method: MIPSSimulator>>leafRetpcIn: (in category 'accessing-abstract') -----
+ leafRetpcIn: aMemory
+ "Answer the retpc assuming that the processor is in a simulated call established
+ by simulateLeafCallOf:nextpc:memory:"
+ ^self ra!

Item was added:
+ ----- Method: MIPSSimulator>>printFields:inRegisterState:on: (in category 'user interface') -----
+ printFields: fields inRegisterState: registerStateVector on: aStream
+ | rsvs |
+ aStream ensureCr.
+ rsvs := registerStateVector readStream.
+ fields withIndexDo:
+ [:sym :index| | val |
+ sym = #cr
+ ifTrue: [aStream cr]
+ ifFalse:
+ [(val := rsvs next) isNil ifTrue: [^self].
+ aStream nextPutAll: sym; nextPut: $:; space.
+ val printOn: aStream base: 16 length: 8 padded: true.
+ val > 16 ifTrue:
+ [aStream space; nextPut: $(.
+ val printOn: aStream base: 10 length: 1 padded: false.
+ aStream nextPut: $)].
+ (fields at: index + 1) ~~ #cr ifTrue:
+ [aStream tab]]]!

Item was added:
+ ----- Method: MIPSSimulator>>printNameOn: (in category 'user interface') -----
+ printNameOn: aStream
+ self perform: #printOn: withArguments: {aStream} inSuperclass: Object!

Item was added:
+ ----- Method: MIPSSimulator>>printRegisterState:on: (in category 'user interface') -----
+ printRegisterState: registerStateVector on: aStream
+ #( (at v0 v1 cr)
+ (a0 a1 a2 a3 cr)
+ (t0 t1 t2 t3 cr)
+ (t4 t5 t6 t7 cr)
+ (s0 s1 s2 s3 cr)
+ (s4 s5 s6 s7 cr)
+ (t8 t9 k0 k1 cr)
+ (gp sp fp ra cr)) doWithIndex:
+ [:subset :index|
+ (subset anySatisfy: [:getter| getter ~~ #cr and: [(self perform: getter) ~= 0]]) ifTrue:
+ [self printFields: subset
+ inRegisterState: (registerStateVector copyFrom: index * 4 - 3 to: index * 4)
+ on: aStream]].
+ self printFields: #(pc cr)
+ inRegisterState: (registerStateVector last: 1)
+ on: aStream!

Item was changed:
+ ----- Method: MIPSSimulator>>printRegistersOn: (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>printRegistersOn: (in category 'registers') -----
  printRegistersOn: stream
  0 to: 31 do:
  [:reg |
  stream space.
  stream nextPutAll: (MIPSConstants nameForRegister: reg).
  stream space.
  (self unsignedRegister: reg) printOn: stream base: 16 nDigits: 8.
  stream space.
  (self signedRegister: reg) printOn: stream.
  stream cr].
 
  stream nextPutAll: ' hi '.
  hi printOn: stream base: 16 nDigits: 8.
  stream space.
  hi printOn: stream.
  stream cr.
 
  stream nextPutAll: ' lo '.
  lo printOn: stream base: 16 nDigits: 8.
  stream space.
  lo printOn: stream.
  stream cr.
 
  stream nextPutAll: ' pc '.
  pc printOn: stream base: 16 nDigits: 8.
  stream space.
  pc printOn: stream.
  stream cr.!

Item was changed:
+ ----- Method: MIPSSimulator>>ra (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>ra (in category 'registers') -----
  ra
  ^self unsignedRegister: RA!

Item was changed:
+ ----- Method: MIPSSimulator>>ra: (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>ra: (in category 'registers') -----
  ra: anInteger
  ^self unsignedRegister: RA put: anInteger!

Item was changed:
+ ----- Method: MIPSSimulator>>s0 (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>s0 (in category 'registers') -----
  s0
  ^self unsignedRegister: S0!

Item was changed:
+ ----- Method: MIPSSimulator>>s0: (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>s0: (in category 'registers') -----
  s0: anInteger
  ^self unsignedRegister: S0 put: anInteger!

Item was changed:
+ ----- Method: MIPSSimulator>>s1 (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>s1 (in category 'registers') -----
  s1
  ^self unsignedRegister: S1!

Item was changed:
+ ----- Method: MIPSSimulator>>s1: (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>s1: (in category 'registers') -----
  s1: anInteger
  ^self unsignedRegister: S1 put: anInteger!

Item was changed:
+ ----- Method: MIPSSimulator>>s2 (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>s2 (in category 'registers') -----
  s2
  ^self unsignedRegister: S2!

Item was changed:
+ ----- Method: MIPSSimulator>>s2: (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>s2: (in category 'registers') -----
  s2: anInteger
  ^self unsignedRegister: S2 put: anInteger!

Item was changed:
+ ----- Method: MIPSSimulator>>s3 (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>s3 (in category 'registers') -----
  s3
  ^self unsignedRegister: S3!

Item was changed:
+ ----- Method: MIPSSimulator>>s3: (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>s3: (in category 'registers') -----
  s3: anInteger
  ^self unsignedRegister: S3 put: anInteger!

Item was changed:
+ ----- Method: MIPSSimulator>>s4 (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>s4 (in category 'registers') -----
  s4
  ^self unsignedRegister: S4!

Item was changed:
+ ----- Method: MIPSSimulator>>s4: (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>s4: (in category 'registers') -----
  s4: anInteger
  ^self unsignedRegister: S4 put: anInteger!

Item was changed:
+ ----- Method: MIPSSimulator>>s5 (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>s5 (in category 'registers') -----
  s5
  ^self unsignedRegister: S5!

Item was changed:
+ ----- Method: MIPSSimulator>>s5: (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>s5: (in category 'registers') -----
  s5: anInteger
  ^self unsignedRegister: S5 put: anInteger!

Item was changed:
+ ----- Method: MIPSSimulator>>s6 (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>s6 (in category 'registers') -----
  s6
  ^self unsignedRegister: S6!

Item was changed:
+ ----- Method: MIPSSimulator>>s6: (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>s6: (in category 'registers') -----
  s6: anInteger
  ^self unsignedRegister: S6 put: anInteger!

Item was changed:
+ ----- Method: MIPSSimulator>>s7 (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>s7 (in category 'registers') -----
  s7
  ^self unsignedRegister: S7!

Item was changed:
+ ----- Method: MIPSSimulator>>s7: (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>s7: (in category 'registers') -----
  s7: anInteger
  ^self unsignedRegister: S7 put: anInteger!

Item was changed:
+ ----- Method: MIPSSimulator>>setterForRegister: (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>setterForRegister: (in category 'registers') -----
  setterForRegister: registerNumber
  ^#(zr: at: v0: v1: a0: a1: a2: a3:
  t0: t1: t2: t3: t4: t5: t6: t7:
  s0: s1: s2: s3: s4: s5: s6: s7:
  t8: t9: k0: k1: gp: sp: fp: ra:) at: registerNumber + 1!

Item was changed:
+ ----- Method: MIPSSimulator>>signedRegister: (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>signedRegister: (in category 'registers') -----
  signedRegister: registerNumber
  registerNumber == ZR ifTrue: [^0] ifFalse: [^registers at: registerNumber + 1].!

Item was changed:
+ ----- Method: MIPSSimulator>>signedRegister:put: (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>signedRegister:put: (in category 'registers') -----
  signedRegister: registerNumber put: signedValue
  self assert: (signedValue between: -16r80000000 and: 16r7FFFFFFF).
  registerNumber == ZR ifFalse: [^registers at: registerNumber + 1 put: signedValue].!

Item was added:
+ ----- Method: MIPSSimulator>>simulateLeafReturnIn: (in category 'execution') -----
+ simulateLeafReturnIn: aMemory
+ self pc: self ra!

Item was added:
+ ----- Method: MIPSSimulator>>singleStepIn:minimumAddress:readOnlyBelow: (in category 'execution') -----
+ singleStepIn: aMemory minimumAddress: minimumAddress readOnlyBelow: minimumWritableAddress
+ memory := aMemory.
+ readableBase := minimumAddress.
+ writableBase := minimumWritableAddress.
+ self step!

Item was changed:
+ ----- Method: MIPSSimulator>>sp (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>sp (in category 'registers') -----
  sp
  ^self unsignedRegister: SP!

Item was changed:
+ ----- Method: MIPSSimulator>>sp: (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>sp: (in category 'registers') -----
  sp: anInteger
  ^self unsignedRegister: SP put: anInteger!

Item was changed:
+ ----- Method: MIPSSimulator>>t0 (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>t0 (in category 'registers') -----
  t0
  ^self unsignedRegister: T0!

Item was changed:
+ ----- Method: MIPSSimulator>>t0: (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>t0: (in category 'registers') -----
  t0: anInteger
  ^self unsignedRegister: T0 put: anInteger!

Item was changed:
+ ----- Method: MIPSSimulator>>t1 (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>t1 (in category 'registers') -----
  t1
  ^self unsignedRegister: T1!

Item was changed:
+ ----- Method: MIPSSimulator>>t1: (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>t1: (in category 'registers') -----
  t1: anInteger
  ^self unsignedRegister: T1 put: anInteger!

Item was changed:
+ ----- Method: MIPSSimulator>>t2 (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>t2 (in category 'registers') -----
  t2
  ^self unsignedRegister: T2!

Item was changed:
+ ----- Method: MIPSSimulator>>t2: (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>t2: (in category 'registers') -----
  t2: anInteger
  ^self unsignedRegister: T2 put: anInteger!

Item was changed:
+ ----- Method: MIPSSimulator>>t3 (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>t3 (in category 'registers') -----
  t3
  ^self unsignedRegister: T3!

Item was changed:
+ ----- Method: MIPSSimulator>>t3: (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>t3: (in category 'registers') -----
  t3: anInteger
  ^self unsignedRegister: T3 put: anInteger!

Item was changed:
+ ----- Method: MIPSSimulator>>t4 (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>t4 (in category 'registers') -----
  t4
  ^self unsignedRegister: T4!

Item was changed:
+ ----- Method: MIPSSimulator>>t4: (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>t4: (in category 'registers') -----
  t4: anInteger
  ^self unsignedRegister: T4 put: anInteger!

Item was changed:
+ ----- Method: MIPSSimulator>>t5 (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>t5 (in category 'registers') -----
  t5
  ^self unsignedRegister: T5!

Item was changed:
+ ----- Method: MIPSSimulator>>t5: (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>t5: (in category 'registers') -----
  t5: anInteger
  ^self unsignedRegister: T5 put: anInteger!

Item was changed:
+ ----- Method: MIPSSimulator>>t6 (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>t6 (in category 'registers') -----
  t6
  ^self unsignedRegister: T6!

Item was changed:
+ ----- Method: MIPSSimulator>>t6: (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>t6: (in category 'registers') -----
  t6: anInteger
  ^self unsignedRegister: T6 put: anInteger!

Item was changed:
+ ----- Method: MIPSSimulator>>t7 (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>t7 (in category 'registers') -----
  t7
  ^self unsignedRegister: T7!

Item was changed:
+ ----- Method: MIPSSimulator>>t7: (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>t7: (in category 'registers') -----
  t7: anInteger
  ^self unsignedRegister: T7 put: anInteger!

Item was changed:
+ ----- Method: MIPSSimulator>>t8 (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>t8 (in category 'registers') -----
  t8
  ^self unsignedRegister: T8!

Item was changed:
+ ----- Method: MIPSSimulator>>t8: (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>t8: (in category 'registers') -----
  t8: anInteger
  ^self unsignedRegister: T8 put: anInteger!

Item was changed:
+ ----- Method: MIPSSimulator>>t9 (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>t9 (in category 'registers') -----
  t9
  ^self unsignedRegister: T9!

Item was changed:
+ ----- Method: MIPSSimulator>>t9: (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>t9: (in category 'registers') -----
  t9: anInteger
  ^self unsignedRegister: T9 put: anInteger!

Item was changed:
+ ----- Method: MIPSSimulator>>unsignedRegister: (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>unsignedRegister: (in category 'registers') -----
  unsignedRegister: registerNumber
  registerNumber == ZR
  ifTrue: [^0]
  ifFalse: [^self signed32ToUnsigned32: (registers at: registerNumber + 1)].!

Item was changed:
+ ----- Method: MIPSSimulator>>unsignedRegister:put: (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>unsignedRegister:put: (in category 'registers') -----
  unsignedRegister: registerNumber put: unsignedValue
  registerNumber == ZR ifFalse:
  [^registers at: registerNumber + 1 put: (self unsigned32ToSigned32: unsignedValue)].!

Item was changed:
+ ----- Method: MIPSSimulator>>v0 (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>v0 (in category 'registers') -----
  v0
  ^self unsignedRegister: V0!

Item was changed:
+ ----- Method: MIPSSimulator>>v0: (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>v0: (in category 'registers') -----
  v0: anInteger
  ^self unsignedRegister: V0 put: anInteger!

Item was changed:
+ ----- Method: MIPSSimulator>>v1 (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>v1 (in category 'registers') -----
  v1
  ^self unsignedRegister: V1!

Item was changed:
+ ----- Method: MIPSSimulator>>v1: (in category 'accessing-registers') -----
- ----- Method: MIPSSimulator>>v1: (in category 'registers') -----
  v1: anInteger
  ^self unsignedRegister: V1 put: anInteger!

Item was added:
+ ----- Method: MIPSSimulator>>zr (in category 'accessing-registers') -----
+ zr
+ ^0!