added divmod() and divmodw() builtin functions to efficiently compute division and remainder in a single call

This commit is contained in:
Irmen de Jong 2023-03-29 23:46:44 +02:00
parent 11216017cb
commit d936568b76
12 changed files with 182 additions and 47 deletions

View File

@ -85,6 +85,8 @@ val BuiltinFunctions: Map<String, FSignature> = mapOf(
"sizeof" to FSignature(true, listOf(FParam("object", DataType.values())), DataType.UBYTE),
"sgn" to FSignature(true, listOf(FParam("value", NumericDatatypesNoBool)), DataType.BYTE),
"sqrt16" to FSignature(true, listOf(FParam("value", arrayOf(DataType.UWORD))), DataType.UBYTE),
"divmod" to FSignature(false, listOf(FParam("number", arrayOf(DataType.UBYTE)), FParam("divident", arrayOf(DataType.UBYTE)), FParam("division", arrayOf(DataType.UBYTE)), FParam("remainder", arrayOf(DataType.UBYTE))), null),
"divmodw" to FSignature(false, listOf(FParam("number", arrayOf(DataType.UWORD)), FParam("divident", arrayOf(DataType.UWORD)), FParam("division", arrayOf(DataType.UWORD)), FParam("remainder", arrayOf(DataType.UWORD))), null),
"any" to FSignature(true, listOf(FParam("values", ArrayDatatypes)), DataType.UBYTE),
"all" to FSignature(true, listOf(FParam("values", ArrayDatatypes)), DataType.UBYTE),
"lsb" to FSignature(true, listOf(FParam("value", arrayOf(DataType.UWORD, DataType.WORD))), DataType.UBYTE),

View File

@ -34,6 +34,8 @@ internal class BuiltinFunctionsAsmGen(private val program: PtProgram,
"any", "all" -> funcAnyAll(fcall, resultToStack, resultRegister, sscope)
"sgn" -> funcSgn(fcall, resultToStack, resultRegister, sscope)
"sqrt16" -> funcSqrt16(fcall, resultToStack, resultRegister, sscope)
"divmod" -> funcDivmod(fcall)
"divmodw" -> funcDivmodW(fcall)
"rol" -> funcRol(fcall)
"rol2" -> funcRol2(fcall)
"ror" -> funcRor(fcall)
@ -76,6 +78,39 @@ internal class BuiltinFunctionsAsmGen(private val program: PtProgram,
return BuiltinFunctions.getValue(fcall.name).returnType
}
private fun funcDivmod(fcall: PtBuiltinFunctionCall) {
assignAsmGen.assignExpressionToRegister(fcall.args[0], RegisterOrPair.A, false)
asmgen.saveRegisterStack(CpuRegister.A, false)
assignAsmGen.assignExpressionToRegister(fcall.args[1], RegisterOrPair.Y, false)
asmgen.restoreRegisterStack(CpuRegister.A ,false)
// math.divmod_ub_asm: -- divide A by Y, result quotient in Y, remainder in A (unsigned)
asmgen.out(" jsr math.divmod_ub_asm")
val var2name = asmgen.asmVariableName(fcall.args[2] as PtIdentifier)
val var3name = asmgen.asmVariableName(fcall.args[3] as PtIdentifier)
val divisionTarget = AsmAssignTarget(TargetStorageKind.VARIABLE, asmgen, DataType.UBYTE, fcall.definingISub(), fcall.args[2].position, var2name)
val remainderTarget = AsmAssignTarget(TargetStorageKind.VARIABLE, asmgen, DataType.UBYTE, fcall.definingISub(), fcall.args[3].position, var3name)
assignAsmGen.assignRegisterByte(remainderTarget, CpuRegister.A)
assignAsmGen.assignRegisterByte(divisionTarget, CpuRegister.Y)
}
private fun funcDivmodW(fcall: PtBuiltinFunctionCall) {
assignAsmGen.assignExpressionToVariable(fcall.args[0], "P8ZP_SCRATCH_W1", DataType.UWORD)
assignAsmGen.assignExpressionToRegister(fcall.args[1], RegisterOrPair.AY, false)
// math.divmod_uw_asm: -- divide two unsigned words (16 bit each) into 16 bit results
// input: P8ZP_SCRATCH_W1 in ZP: 16 bit number, A/Y: 16 bit divisor
// output: P8ZP_SCRATCH_W2 in ZP: 16 bit remainder, A/Y: 16 bit division result
asmgen.out(" jsr math.divmod_uw_asm")
val var2name = asmgen.asmVariableName(fcall.args[2] as PtIdentifier)
val divisionTarget = AsmAssignTarget(TargetStorageKind.VARIABLE, asmgen, DataType.UBYTE, fcall.definingISub(), fcall.args[2].position, var2name)
val remainderVar = asmgen.asmVariableName(fcall.args[3] as PtIdentifier)
assignAsmGen.assignRegisterpairWord(divisionTarget, RegisterOrPair.AY)
asmgen.out("""
lda P8ZP_SCRATCH_W2
ldy P8ZP_SCRATCH_W2+1
sta $remainderVar
sty $remainderVar+1""")
}
private fun funcRsave() {
if (asmgen.isTargetCpu(CpuType.CPU65c02))
asmgen.out("""

View File

@ -17,6 +17,8 @@ internal class BuiltinFuncGen(private val codeGen: IRCodeGen, private val exprGe
"cmp" -> funcCmp(call)
"sgn" -> funcSgn(call)
"sqrt16" -> funcSqrt16(call)
"divmod" -> funcDivmod(call, IRDataType.BYTE)
"divmodw" -> funcDivmod(call, IRDataType.WORD)
"pop" -> funcPop(call)
"popw" -> funcPopw(call)
"push" -> funcPush(call)
@ -45,6 +47,27 @@ internal class BuiltinFuncGen(private val codeGen: IRCodeGen, private val exprGe
}
}
private fun funcDivmod(call: PtBuiltinFunctionCall, type: IRDataType): ExpressionCodeResult {
val result = mutableListOf<IRCodeChunkBase>()
val number = call.args[0]
val divident = call.args[1]
if(divident is PtNumber) {
val tr = exprGen.translateExpression(number)
addToResult(result, tr, tr.resultReg, -1)
addInstr(result, IRInstruction(Opcode.DIVMOD, type, reg1 = tr.resultReg, value=divident.number.toInt()), null)
} else {
val numTr = exprGen.translateExpression(number)
addToResult(result, numTr, numTr.resultReg, -1)
val dividentTr = exprGen.translateExpression(divident)
addToResult(result, dividentTr, dividentTr.resultReg, -1)
addInstr(result, IRInstruction(Opcode.DIVMODR, type, reg1 = numTr.resultReg, reg2=dividentTr.resultReg), null)
}
// DIVMOD result convention: division in r0, remainder in r1
result += assignRegisterTo(call.args[2], 0)
result += assignRegisterTo(call.args[3], 1)
return ExpressionCodeResult(result, type, -1, -1)
}
private fun funcCmp(call: PtBuiltinFunctionCall): ExpressionCodeResult {
val result = mutableListOf<IRCodeChunkBase>()
val leftTr = exprGen.translateExpression(call.args[0])

View File

@ -5,7 +5,7 @@ import prog8.intermediate.SyscallRegisterBase
internal class RegisterPool {
// reserve 0,1,2 for return values of subroutine calls and syscalls
// TODO set this back to 0 once 'resultRegister' has been removed everywhere?
// TODO set this back to 0 once 'resultRegister' has been removed everywhere and SYSCALL/DIVMOD fixed?
private var firstFree: Int=3
private var firstFreeFloat: Int=3

View File

@ -39,8 +39,8 @@ romsub $af18 = FADD(uword mflpt @ AY) clobbers(A,X,Y) ; fac1 += mflpt valu
romsub $af1b = FADDT() clobbers(A,X,Y) ; fac1 += fac2 NOTE: use FADDT2() instead!
romsub $af1e = FMULT(uword mflpt @ AY) clobbers(A,X,Y) ; fac1 *= mflpt value from A/Y
romsub $af21 = FMULTT() clobbers(A,X,Y) ; fac1 *= fac2 NOTE: use FMULTT2() instead!
romsub $af24 = FDIV(uword mflpt @ AY) clobbers(A,X,Y) ; fac1 = mflpt in A/Y / fac1 (remainder in fac2)
romsub $af27 = FDIVT() clobbers(A,X,Y) ; fac1 = fac2/fac1 (remainder in fac2) mind the order of the operands NOTE: use FDIVT2() instead!
romsub $af24 = FDIV(uword mflpt @ AY) clobbers(A,X,Y) ; fac1 = mflpt in A/Y / fac1
romsub $af27 = FDIVT() clobbers(A,X,Y) ; fac1 = fac2/fac1 mind the order of the operands NOTE: use FDIVT2() instead!
romsub $af2a = LOG() clobbers(A,X,Y) ; fac1 = LN(fac1) (natural log)
romsub $af2d = INT() clobbers(A,X,Y) ; INT() truncates, use FADDH first to round instead of trunc
romsub $af30 = SQR() clobbers(A,X,Y) ; fac1 = SQRT(fac1)
@ -75,7 +75,7 @@ romsub $af7b = NEGFAC() clobbers(A) ; switch the sign of
romsub $af7e = FMULTT2() clobbers(A,X,Y) ; fac1 *= fac2
romsub $af81 = MUL10() clobbers(A,X,Y) ; fac1 *= 10
romsub $af84 = DIV10() clobbers(A,X,Y) ; fac1 /= 10 , CAUTION: result is always positive!
romsub $af87 = FDIVT2() clobbers(A,X,Y) ; fac1 = fac2/fac1 (remainder in fac2) mind the order of the operands
romsub $af87 = FDIVT2() clobbers(A,X,Y) ; fac1 = fac2/fac1 mind the order of the operands
romsub $af8a = MOVEF() clobbers(A,X) ; copy fac1 to fac2
romsub $af8d = SGN() clobbers(A,X,Y) ; fac1 = SGN(fac1), result of SIGN (-1, 0 or 1)
romsub $af90 = FLOAT() clobbers(A,X,Y) ; FAC = (s8).A

View File

@ -60,8 +60,8 @@ romsub $b853 = FSUBT() clobbers(A,X,Y) ; fac1 = fac2-fac1
romsub $b850 = FSUB(uword mflpt @ AY) clobbers(A,X,Y) ; fac1 = mflpt from A/Y - fac1
romsub $ba2b = FMULTT() clobbers(A,X,Y) ; fac1 *= fac2
romsub $ba28 = FMULT(uword mflpt @ AY) clobbers(A,X,Y) ; fac1 *= mflpt value from A/Y
romsub $bb12 = FDIVT() clobbers(A,X,Y) ; fac1 = fac2/fac1 (remainder in fac2) mind the order of the operands
romsub $bb0f = FDIV(uword mflpt @ AY) clobbers(A,X,Y) ; fac1 = mflpt in A/Y / fac1 (remainder in fac2)
romsub $bb12 = FDIVT() clobbers(A,X,Y) ; fac1 = fac2/fac1 mind the order of the operands
romsub $bb0f = FDIV(uword mflpt @ AY) clobbers(A,X,Y) ; fac1 = mflpt in A/Y / fac1
romsub $bf7b = FPWRT() clobbers(A,X,Y) ; fac1 = fac2 ** fac1
romsub $bf78 = FPWR(uword mflpt @ AY) clobbers(A,X,Y) ; fac1 = fac2 ** mflpt from A/Y
romsub $bd7e = FINLOG(byte value @A) clobbers (A, X, Y) ; fac1 += signed byte in A

View File

@ -40,8 +40,8 @@ romsub $fe18 = FADD(uword mflpt @ AY) clobbers(A,X,Y) ; fac1 += mflpt valu
romsub $fe1b = FADDT() clobbers(A,X,Y) ; fac1 += fac2
romsub $fe1e = FMULT(uword mflpt @ AY) clobbers(A,X,Y) ; fac1 *= mflpt value from A/Y
romsub $fe21 = FMULTT() clobbers(A,X,Y) ; fac1 *= fac2
romsub $fe24 = FDIV(uword mflpt @ AY) clobbers(A,X,Y) ; fac1 = mflpt in A/Y / fac1 (remainder in fac2)
romsub $fe27 = FDIVT() clobbers(A,X,Y) ; fac1 = fac2/fac1 (remainder in fac2) mind the order of the operands
romsub $fe24 = FDIV(uword mflpt @ AY) clobbers(A,X,Y) ; fac1 = mflpt in A/Y / fac1
romsub $fe27 = FDIVT() clobbers(A,X,Y) ; fac1 = fac2/fac1 mind the order of the operands
romsub $fe2a = LOG() clobbers(A,X,Y) ; fac1 = LN(fac1) (natural log)
romsub $fe2d = INT() clobbers(A,X,Y) ; INT() truncates, use FADDH first to round instead of trunc
romsub $fe30 = SQR() clobbers(A,X,Y) ; fac1 = SQRT(fac1)

View File

@ -6,6 +6,7 @@ import prog8.ast.base.SyntaxError
import prog8.ast.expressions.*
import prog8.ast.statements.*
import prog8.ast.walk.IAstVisitor
import prog8.code.ast.PtIdentifier
import prog8.code.core.*
import prog8.code.target.VMTarget
import prog8.compiler.builtinFunctionReturnType
@ -1137,6 +1138,22 @@ internal class AstChecker(private val program: Program,
}
}
}
else if(funcName[0] == "divmod") {
if(functionCallStatement.args[2] !is IdentifierReference || functionCallStatement.args[3] !is IdentifierReference)
errors.err("arguments 3 and 4 must be variables to receive the division and remainder", functionCallStatement.position)
if(functionCallStatement.args[2] is TypecastExpression || functionCallStatement.args[3] is TypecastExpression)
errors.err("all arguments must be ubyte", functionCallStatement.position)
if(!functionCallStatement.args.all {it.inferType(program) istype DataType.UBYTE})
errors.err("all arguments must be ubyte", functionCallStatement.position)
}
else if(funcName[0] == "divmodw") {
if(functionCallStatement.args[2] !is IdentifierReference || functionCallStatement.args[3] !is IdentifierReference)
errors.err("arguments 3 and 4 must be variables to receive the division and remainder", functionCallStatement.position)
if(functionCallStatement.args[2] is TypecastExpression || functionCallStatement.args[3] is TypecastExpression)
errors.err("all arguments must be uword", functionCallStatement.position)
if(!functionCallStatement.args.all {it.inferType(program) istype DataType.UWORD})
errors.err("all arguments must be uword", functionCallStatement.position)
}
if(funcName[0] in InplaceModifyingBuiltinFunctions) {
// in-place modification, can't be done on literals

View File

@ -774,6 +774,13 @@ sqrt16(w)
16 bit unsigned integer Square root. Result is unsigned byte.
To do the reverse, squaring an integer, just write ``x*x``.
divmod(number, divident, division, remainder)
Performs division and remainder calculation in a single call. This is faster than using separate '/' and '%' calculations.
All values are ubytes. The last two arguments must be ubyte variables to receive the division and remainder results, respectively.
divmodw(number, divident, division, remainder)
Same as divmod, but for uwords.
Array operations
^^^^^^^^^^^^^^^^

View File

@ -1,38 +1,29 @@
%import textio
%import floats
%zeropage basicsafe
; Draw a mandelbrot in graphics mode (the image will be 256 x 200 pixels).
; NOTE: this will take an eternity to draw on a real c64. A CommanderX16 is a bit faster.
; even in Vice in warp mode (700% speed on my machine) it's slow, but you can see progress
; Note: this program is compatible with C64 and CX16.
main {
sub start() {
float xsquared = 2.0
float ysquared = 1.9
uword w = 1
ubyte h = 0
str name = ".tx2"
ubyte ub1 = 100
ubyte ub2 = 13
ubyte ubd
ubyte ubr
divmod(ub1, ub2, ubd, ubr)
txt.print_ub(ubd)
txt.spc()
txt.print_ub(ubr)
txt.nl()
if name==".jpg" or name==".txt" or name==".gif" {
txt.print("yes")
}
uword uw1 = 10000
uword uw2 = 900
uword uwd
uword uwr
divmodw(uw1, uw2, uwd, uwr)
txt.print_uw(uwd)
txt.spc()
txt.print_uw(uwr)
txt.nl()
; if w==0 or xsquared+ysquared<4.0 {
; txt.print("yes")
; }
; if w==0 {
; txt.print("w=0 ")
; }
; if h==0 {
; txt.print("h=0 ")
; }
; if w==0 or h==0 {
; txt.print(" w or h=0")
; }
}
}

View File

@ -125,6 +125,8 @@ divs reg1, value - signed division reg1 /= value not
divsm reg1, address - signed memory at address /= reg2 note: division by zero yields max signed int 127 / 32767
modr reg1, reg2 - remainder (modulo) of unsigned division reg1 %= reg2 note: division by zero yields max signed int $ff/$ffff
mod reg1, value - remainder (modulo) of unsigned division reg1 %= value note: division by zero yields max signed int $ff/$ffff
divmodr reg1, reg2 - unsigned division reg1/reg2, storing division in r0 and remainder in r2 (by convention, because we can't specify enough registers in the instruction)
divmod reg1, value - unsigned division reg1/value, storing division in r0 and remainder in r2 (by convention, because we can't specify enough registers in the instruction)
sqrt reg1, reg2 - reg1 is the square root of reg2
sgn reg1, reg2 - reg1 is the sign of reg2 (0, 1 or -1)
cmp reg1, reg2 - set processor status bits C, N, Z according to comparison of reg1 with reg2. (semantics taken from 6502/68000 CMP instruction)
@ -290,6 +292,8 @@ enum class Opcode {
DIVSM,
MODR,
MOD,
DIVMODR,
DIVMOD,
SQRT,
SGN,
CMP,
@ -615,6 +619,8 @@ val instructionFormats = mutableMapOf(
Opcode.SGN to InstructionFormat.from("BW,>r1,<r2 | F,>fr1,<fr2"),
Opcode.MODR to InstructionFormat.from("BW,<>r1,<r2"),
Opcode.MOD to InstructionFormat.from("BW,<>r1,<v"),
Opcode.DIVMODR to InstructionFormat.from("BW,<>r1,<r2"),
Opcode.DIVMOD to InstructionFormat.from("BW,<>r1,<v"),
Opcode.CMP to InstructionFormat.from("BW,<r1,<r2"),
Opcode.EXT to InstructionFormat.from("BW,<>r1"),
Opcode.EXTS to InstructionFormat.from("BW,<>r1"),

View File

@ -229,6 +229,8 @@ class VirtualMachine(irProgram: IRProgram) {
Opcode.DIVSM -> InsDIVSM(ins)
Opcode.MODR -> InsMODR(ins)
Opcode.MOD -> InsMOD(ins)
Opcode.DIVMODR -> InsDIVMODR(ins)
Opcode.DIVMOD -> InsDIVMOD(ins)
Opcode.SGN -> InsSGN(ins)
Opcode.CMP -> InsCMP(ins)
Opcode.SQRT -> InsSQRT(ins)
@ -1110,8 +1112,8 @@ class VirtualMachine(irProgram: IRProgram) {
private fun InsDIVR(i: IRInstruction) {
when(i.type!!) {
IRDataType.BYTE -> divModByteUnsigned("/", i.reg1!!, i.reg2!!)
IRDataType.WORD -> divModWordUnsigned("/", i.reg1!!, i.reg2!!)
IRDataType.BYTE -> divOrModByteUnsigned("/", i.reg1!!, i.reg2!!)
IRDataType.WORD -> divOrModWordUnsigned("/", i.reg1!!, i.reg2!!)
IRDataType.FLOAT -> throw IllegalArgumentException("invalid float type for this instruction $i")
}
nextPc()
@ -1119,8 +1121,8 @@ class VirtualMachine(irProgram: IRProgram) {
private fun InsDIV(i: IRInstruction) {
when(i.type!!) {
IRDataType.BYTE -> divModConstByteUnsigned("/", i.reg1!!, i.value!!.toUByte())
IRDataType.WORD -> divModConstWordUnsigned("/", i.reg1!!, i.value!!.toUShort())
IRDataType.BYTE -> divOrModConstByteUnsigned("/", i.reg1!!, i.value!!.toUByte())
IRDataType.WORD -> divOrModConstWordUnsigned("/", i.reg1!!, i.value!!.toUShort())
IRDataType.FLOAT -> throw IllegalArgumentException("invalid float type for this instruction $i")
}
nextPc()
@ -1180,8 +1182,8 @@ class VirtualMachine(irProgram: IRProgram) {
private fun InsMODR(i: IRInstruction) {
when(i.type!!) {
IRDataType.BYTE -> divModByteUnsigned("%", i.reg1!!, i.reg2!!)
IRDataType.WORD -> divModWordUnsigned("%", i.reg1!!, i.reg2!!)
IRDataType.BYTE -> divOrModByteUnsigned("%", i.reg1!!, i.reg2!!)
IRDataType.WORD -> divOrModWordUnsigned("%", i.reg1!!, i.reg2!!)
IRDataType.FLOAT -> throw IllegalArgumentException("invalid float type for this instruction $i")
}
nextPc()
@ -1189,8 +1191,26 @@ class VirtualMachine(irProgram: IRProgram) {
private fun InsMOD(i: IRInstruction) {
when(i.type!!) {
IRDataType.BYTE -> divModConstByteUnsigned("%", i.reg1!!, i.value!!.toUByte())
IRDataType.WORD -> divModConstWordUnsigned("%", i.reg1!!, i.value!!.toUShort())
IRDataType.BYTE -> divOrModConstByteUnsigned("%", i.reg1!!, i.value!!.toUByte())
IRDataType.WORD -> divOrModConstWordUnsigned("%", i.reg1!!, i.value!!.toUShort())
IRDataType.FLOAT -> throw IllegalArgumentException("invalid float type for this instruction $i")
}
nextPc()
}
private fun InsDIVMODR(i: IRInstruction) {
when(i.type!!) {
IRDataType.BYTE -> divAndModUByte(i.reg1!!, i.reg2!!) // output in r0+r1
IRDataType.WORD -> divAndModUWord(i.reg1!!, i.reg2!!) // output in r0+r1
IRDataType.FLOAT -> throw IllegalArgumentException("invalid float type for this instruction $i")
}
nextPc()
}
private fun InsDIVMOD(i: IRInstruction) {
when(i.type!!) {
IRDataType.BYTE -> divAndModConstUByte(i.reg1!!, i.value!!.toUByte()) // output in r0+r1
IRDataType.WORD -> divAndModConstUWord(i.reg1!!, i.value!!.toUShort()) // output in r0+r1
IRDataType.FLOAT -> throw IllegalArgumentException("invalid float type for this instruction $i")
}
nextPc()
@ -1329,7 +1349,7 @@ class VirtualMachine(irProgram: IRProgram) {
memory.setSB(address, result.toByte())
}
private fun divModByteUnsigned(operator: String, reg1: Int, reg2: Int) {
private fun divOrModByteUnsigned(operator: String, reg1: Int, reg2: Int) {
val left = registers.getUB(reg1)
val right = registers.getUB(reg2)
val result = when(operator) {
@ -1346,7 +1366,7 @@ class VirtualMachine(irProgram: IRProgram) {
registers.setUB(reg1, result.toUByte())
}
private fun divModConstByteUnsigned(operator: String, reg1: Int, value: UByte) {
private fun divOrModConstByteUnsigned(operator: String, reg1: Int, value: UByte) {
val left = registers.getUB(reg1)
val result = when(operator) {
"/" -> {
@ -1362,6 +1382,40 @@ class VirtualMachine(irProgram: IRProgram) {
registers.setUB(reg1, result.toUByte())
}
private fun divAndModUByte(reg1: Int, reg2: Int) {
val left = registers.getUB(reg1)
val right = registers.getUB(reg2)
val division = if(right==0.toUByte()) 0xffu else left / right
val remainder = if(right==0.toUByte()) 0xffu else left % right
registers.setUB(0, division.toUByte())
registers.setUB(1, remainder.toUByte())
}
private fun divAndModConstUByte(reg1: Int, value: UByte) {
val left = registers.getUB(reg1)
val division = if(value==0.toUByte()) 0xffu else left / value
val remainder = if(value==0.toUByte()) 0xffu else left % value
registers.setUB(0, division.toUByte())
registers.setUB(1, remainder.toUByte())
}
private fun divAndModUWord(reg1: Int, reg2: Int) {
val left = registers.getUW(reg1)
val right = registers.getUW(reg2)
val division = if(right==0.toUShort()) 0xffffu else left / right
val remainder = if(right==0.toUShort()) 0xffffu else left % right
registers.setUW(0, division.toUShort())
registers.setUW(1, remainder.toUShort())
}
private fun divAndModConstUWord(reg1: Int, value: UShort) {
val left = registers.getUW(reg1)
val division = if(value==0.toUShort()) 0xffffu else left / value
val remainder = if(value==0.toUShort()) 0xffffu else left % value
registers.setUW(0, division.toUShort())
registers.setUW(1, remainder.toUShort())
}
private fun divModByteUnsignedInplace(operator: String, reg1: Int, address: Int) {
val left = memory.getUB(address)
val right = registers.getUB(reg1)
@ -1414,7 +1468,7 @@ class VirtualMachine(irProgram: IRProgram) {
memory.setUW(address, result.toUShort())
}
private fun divModWordUnsigned(operator: String, reg1: Int, reg2: Int) {
private fun divOrModWordUnsigned(operator: String, reg1: Int, reg2: Int) {
val left = registers.getUW(reg1)
val right = registers.getUW(reg2)
val result = when(operator) {
@ -1431,7 +1485,7 @@ class VirtualMachine(irProgram: IRProgram) {
registers.setUW(reg1, result.toUShort())
}
private fun divModConstWordUnsigned(operator: String, reg1: Int, value: UShort) {
private fun divOrModConstWordUnsigned(operator: String, reg1: Int, value: UShort) {
val left = registers.getUW(reg1)
val result = when(operator) {
"/" -> {