From 49c1ed26f31101934435bb8a5c574b7ee339ac2c Mon Sep 17 00:00:00 2001 From: Araq Date: Sun, 29 Oct 2023 22:21:47 +0100 Subject: [PATCH 01/10] so close... --- compiler/nir/ast2ir.nim | 5 +++++ compiler/nir/nirinsts.nim | 13 +++++++++++++ compiler/nir/nirvm.nim | 19 +++++++++++-------- 3 files changed, 29 insertions(+), 8 deletions(-) diff --git a/compiler/nir/ast2ir.nim b/compiler/nir/ast2ir.nim index f3b68474b00b7..7b895d1bd019c 100644 --- a/compiler/nir/ast2ir.nim +++ b/compiler/nir/ast2ir.nim @@ -2353,6 +2353,11 @@ proc genParams(c: var ProcCon; params: PNode; prc: PSym) = let res = resNode.sym # get result symbol c.code.addSummon toLineInfo(c, res.info), toSymId(c, res), typeToIr(c.m, res.typ), SummonResult + elif prc.typ.len > 0 and not isEmptyType(prc.typ[0]) and not isCompileTimeOnly(prc.typ[0]): + # happens for procs without bodies: + let t = typeToIr(c.m, prc.typ[0]) + let tmp = allocTemp(c, t) + c.code.addSummon toLineInfo(c, params.info), tmp, t, SummonResult for i in 1.. LastAtomicValue @@ -259,6 +261,17 @@ iterator sonsFrom1*(tree: Tree; n: NodePos): NodePos = yield NodePos pos nextChild tree, pos +iterator sonsFrom2*(tree: Tree; n: NodePos): NodePos = + var pos = n.int + assert tree.nodes[pos].kind > LastAtomicValue + let last = pos + tree.nodes[pos].rawSpan + inc pos + nextChild tree, pos + nextChild tree, pos + while pos < last: + yield NodePos pos + nextChild tree, pos + template `[]`*(t: Tree; n: NodePos): Instr = t.nodes[n.int] proc span(tree: Tree; pos: int): int {.inline.} = diff --git a/compiler/nir/nirvm.nim b/compiler/nir/nirvm.nim index 1f2f4e326cd46..f42e9ab47c122 100644 --- a/compiler/nir/nirvm.nim +++ b/compiler/nir/nirvm.nim @@ -325,7 +325,7 @@ proc toString*(t: Bytecode; pos: CodePos; r.add $t.m.lit.numbers[LitId t[pos].operand] of StrValM: escapeToNimLit(t.m.lit.strings[LitId t[pos].operand], r) - of LoadLocalM, LoadGlobalM, LoadProcM, AllocLocals: + of LoadLocalM, LoadGlobalM, LoadProcM, AllocLocals, SummonParamM: r.add $t[pos].kind r.add ' ' r.add $t[pos].operand @@ -593,14 +593,14 @@ proc preprocess(c: var Preprocessing; bc: var Bytecode; t: Tree; n: NodePos; fla if t[src].kind in {Call, IndirectCall}: # No support for return values, these are mapped to `var T` parameters! build bc, info, CallM: - preprocess(c, bc, t, src.firstSon, {WantAddr}) + preprocess(c, bc, t, src.skipTyped, {WantAddr}) preprocess(c, bc, t, dest, {WantAddr}) - for ch in sonsFrom1(t, src): preprocess(c, bc, t, ch, {WantAddr}) + for ch in sonsFrom2(t, src): preprocess(c, bc, t, ch, {WantAddr}) elif t[src].kind in {CheckedCall, CheckedIndirectCall}: build bc, info, CheckedCallM: - preprocess(c, bc, t, src.firstSon, {WantAddr}) + preprocess(c, bc, t, src.skipTyped, {WantAddr}) preprocess(c, bc, t, dest, {WantAddr}) - for ch in sonsFrom1(t, src): preprocess(c, bc, t, ch, {WantAddr}) + for ch in sonsFrom2(t, src): preprocess(c, bc, t, ch, {WantAddr}) elif t[dest].kind == Load: let (typ, a) = sons2(t, dest) let s = computeSize(bc, tid)[0] @@ -696,7 +696,7 @@ proc preprocess(c: var Preprocessing; bc: var Bytecode; t: Tree; n: NodePos; fla for ch in sons(t, n): preprocess(c2, bc, t, ch, {}) bc.code[toPatch] = toIns(AllocLocals, c2.localsAddr) when false: - if here.int == 40192: + if here.int == 39850: debug bc, t, n debug bc, here @@ -934,9 +934,12 @@ proc eval(c: Bytecode; pc: CodePos; s: StackFrame; result: pointer; size: int) = of LoadLocalM: let dest = s.locals +! c.code[pc].operand copyMem dest, result, size - of FieldAtM, ArrayAtM, LoadM: + of FieldAtM, ArrayAtM, LoadM, LoadGlobalM: let dest = evalAddr(c, pc, s) copyMem dest, result, size + of LoadProcM: + let procAddr = c.code[pc].operand + cast[ptr pointer](result)[] = cast[pointer](procAddr) of CheckedAddM: checkedBinop `+` of CheckedSubM: checkedBinop `-` of CheckedMulM: checkedBinop `*` @@ -1082,8 +1085,8 @@ proc exec(c: Bytecode; pc: CodePos; u: ref Universe) = next c, prc assert c[prc].kind == ImmediateValM let paramSize = c[prc].operand.int - eval(c, a, s2, s2.locals +! paramAddr, paramSize) next c, prc + eval(c, a, s2, s2.locals +! paramAddr, paramSize) s = s2 pc = prc of RetM: From 1ade40ff60e431539d814f8d7d580b19721de7c6 Mon Sep 17 00:00:00 2001 From: Araq Date: Sun, 29 Oct 2023 23:27:30 +0100 Subject: [PATCH 02/10] NIR VM: hello world works --- compiler/nir/nirvm.nim | 25 ++++++++++++++++--------- 1 file changed, 16 insertions(+), 9 deletions(-) diff --git a/compiler/nir/nirvm.nim b/compiler/nir/nirvm.nim index f42e9ab47c122..d382f64c2b2ba 100644 --- a/compiler/nir/nirvm.nim +++ b/compiler/nir/nirvm.nim @@ -1016,15 +1016,23 @@ proc evalProc(c: Bytecode; pc: CodePos; s: StackFrame): CodePos = assert procSym < ForwardedProc result = CodePos(procSym) -proc echoImpl(c: Bytecode; pc: CodePos; s: StackFrame) = - type StringArray = object +type + NimStrPayloadVM = object + cap: int + data: UncheckedArray[char] + NimStringVM = object len: int - data: ptr UncheckedArray[string] - var sa = default(StringArray) + p: ptr NimStrPayloadVM + +proc echoImpl(c: Bytecode; pc: CodePos; frame: StackFrame) = + var s = default(NimStringVM) for a in sonsFrom1(c, pc): - eval(c, a, s, addr(sa), sizeof(sa)) - for i in 0.. 0: + discard stdout.writeBuffer(addr(s.p.data[0]), s.len) stdout.write "\n" stdout.flushFile() @@ -1034,12 +1042,11 @@ proc evalBuiltin(c: Bytecode; pc: CodePos; s: StackFrame; prc: CodePos; didEval: case c[prc].kind of PragmaPairM: let (x, y) = sons2(c.code, prc) - if cast[PragmaKey](c[x]) == CoreName: + if cast[PragmaKey](c[x].operand) == CoreName: let lit = c[y].litId case c.m.lit.strings[lit] of "echoBinSafe": echoImpl(c, pc, s) else: discard - echo "running compilerproc: ", c.m.lit.strings[lit] didEval = true of PragmaIdM, AllocLocals: discard else: break From 93dd085095afb81bcc27a1fe2b353ddbde325e07 Mon Sep 17 00:00:00 2001 From: Araq Date: Tue, 31 Oct 2023 09:29:09 +0100 Subject: [PATCH 03/10] NIR: better addressing modes --- compiler/main.nim | 4 +- compiler/nir/ast2ir.nim | 33 ++++++++++------ compiler/nir/nirinsts.nim | 8 +++- compiler/nir/nirvm.nim | 79 ++++++++++++++++++++++----------------- 4 files changed, 75 insertions(+), 49 deletions(-) diff --git a/compiler/main.nim b/compiler/main.nim index 0627a61bb49c3..6651128ebf730 100644 --- a/compiler/main.nim +++ b/compiler/main.nim @@ -201,7 +201,9 @@ proc commandCompileToJS(graph: ModuleGraph) = proc commandInteractive(graph: ModuleGraph; useNir: bool) = graph.config.setErrorMaxHighMaybe initDefines(graph.config.symbols) - if not useNir: + if useNir: + defineSymbol(graph.config.symbols, "noSignalHandler") + else: defineSymbol(graph.config.symbols, "nimscript") # note: seems redundant with -d:nimHasLibFFI when hasFFI: defineSymbol(graph.config.symbols, "nimffi") diff --git a/compiler/nir/ast2ir.nim b/compiler/nir/ast2ir.nim index 7b895d1bd019c..4786919861240 100644 --- a/compiler/nir/ast2ir.nim +++ b/compiler/nir/ast2ir.nim @@ -1669,7 +1669,7 @@ proc addSliceFields(c: var ProcCon; target: var Tree; info: PackedLineInfo; buildTyped target, info, ObjConstr, typeToIr(c.m, n.typ): target.addImmediateVal info, 0 buildTyped target, info, AddrOf, elemType: - buildTyped target, info, ArrayAt, pay[1]: + buildTyped target, info, DerefArrayAt, pay[1]: buildTyped target, info, FieldAt, typeToIr(c.m, arrType): copyTree target, x target.addImmediateVal info, 1 # (len, p)-pair @@ -1716,7 +1716,7 @@ proc addSliceFields(c: var ProcCon; target: var Tree; info: PackedLineInfo; buildTyped target, info, ObjConstr, typeToIr(c.m, n.typ): target.addImmediateVal info, 0 buildTyped target, info, AddrOf, elemType: - buildTyped target, info, ArrayAt, pay: + buildTyped target, info, DerefArrayAt, pay: buildTyped target, info, FieldAt, typeToIr(c.m, arrType): copyTree target, x target.addImmediateVal info, 0 # (p, len)-pair @@ -1977,7 +1977,7 @@ proc addAddrOfFirstElem(c: var ProcCon; target: var Tree; info: PackedLineInfo; let t = typeToIr(c.m, typ) target.addImmediateVal info, 0 buildTyped target, info, AddrOf, elemType: - buildTyped target, info, ArrayAt, c.m.strPayloadId[1]: + buildTyped target, info, DerefArrayAt, c.m.strPayloadId[1]: buildTyped target, info, FieldAt, typeToIr(c.m, arrType): copyTree target, tmp target.addImmediateVal info, 1 # (len, p)-pair @@ -1992,7 +1992,7 @@ proc addAddrOfFirstElem(c: var ProcCon; target: var Tree; info: PackedLineInfo; let t = typeToIr(c.m, typ) target.addImmediateVal info, 0 buildTyped target, info, AddrOf, elemType: - buildTyped target, info, ArrayAt, seqPayloadPtrType(c.m.types, c.m.nirm.types, typ)[1]: + buildTyped target, info, DerefArrayAt, seqPayloadPtrType(c.m.types, c.m.nirm.types, typ)[1]: buildTyped target, info, FieldAt, typeToIr(c.m, arrType): copyTree target, tmp target.addImmediateVal info, 1 # (len, p)-pair @@ -2102,10 +2102,11 @@ proc genSeqConstr(c: var ProcCon; n: PNode; d: var Value) = for i in 0.. DerefFieldAt instead of FieldAt: + n0 = n[0] + opc = DerefFieldAt + + let a = genx(c, n0, flags) template body(target) = - buildTyped target, info, FieldAt, typeToIr(c.m, n[0].typ): + buildTyped target, info, opc, typeToIr(c.m, n0.typ): copyTree target, a genField c, n[1], Value(target) diff --git a/compiler/nir/nirinsts.nim b/compiler/nir/nirinsts.nim index 31f6526549ca3..b63c3b07aba4c 100644 --- a/compiler/nir/nirinsts.nim +++ b/compiler/nir/nirinsts.nim @@ -63,8 +63,10 @@ type Kill, # `Kill x`: scope end for `x` AddrOf, - ArrayAt, # addr(a[i]) - FieldAt, # addr(obj.field) + ArrayAt, # a[i] + DerefArrayAt, # a[i] where `a` is a PtrArray; `a[][i]` + FieldAt, # obj.field + DerefFieldAt, # obj[].field Load, # a[] Store, # a[] = b @@ -162,7 +164,9 @@ const AddrOf, Load, ArrayAt, + DerefArrayAt, FieldAt, + DerefFieldAt, TestOf } diff --git a/compiler/nir/nirvm.nim b/compiler/nir/nirvm.nim index d382f64c2b2ba..097cd743ec5f8 100644 --- a/compiler/nir/nirvm.nim +++ b/compiler/nir/nirvm.nim @@ -48,7 +48,9 @@ type AddrOfM, ArrayAtM, # (elemSize, addr(a), i) + DerefArrayAtM, FieldAtM, # addr(obj.field) + DerefFieldAtM, LoadM, # a[] AsgnM, # a = b @@ -545,39 +547,30 @@ proc preprocess(c: var Preprocessing; bc: var Bytecode; t: Tree; n: NodePos; fla let (arrayType, a, i) = sons3(t, n) let tid = t[arrayType].typeId let size = uint32 computeElemSize(bc, tid) - if t[a].kind == Load: - let (_, arg) = sons2(t, a) - build bc, info, LoadM: - bc.add info, ImmediateValM, size - build bc, info, ArrayAtM: - bc.add info, ImmediateValM, size - preprocess(c, bc, t, arg, {WantAddr}) - preprocess(c, bc, t, i, {WantAddr}) - else: - build bc, info, ArrayAtM: - bc.add info, ImmediateValM, size - preprocess(c, bc, t, a, {WantAddr}) - preprocess(c, bc, t, i, {WantAddr}) + build bc, info, ArrayAtM: + bc.add info, ImmediateValM, size + preprocess(c, bc, t, a, {WantAddr}) + preprocess(c, bc, t, i, {WantAddr}) + of DerefArrayAt: + let (arrayType, a, i) = sons3(t, n) + let tid = t[arrayType].typeId + let size = uint32 computeElemSize(bc, tid) + build bc, info, DerefArrayAtM: + bc.add info, ImmediateValM, size + preprocess(c, bc, t, a, {WantAddr}) + preprocess(c, bc, t, i, {WantAddr}) of FieldAt: - # a[] conceptually loads a block of size of T. But when applied to an object selector - # only a subset of the data is really requested so `(a[] : T).field` - # becomes `(a+offset(field))[] : T_Field` - # And now if this is paired with `addr` the deref disappears, as usual: `addr x.field[]` - # is `(x+offset(field))`. let (typ, a, b) = sons3(t, n) - if t[a].kind == Load: - let (_, arg) = sons2(t, a) - build bc, info, LoadM: - bc.add info, ImmediateValM, uint32 computeSize(bc, t[typ].typeId)[0] - let offset = bc.offsets[t[typ].typeId][t[b].immediateVal][0] - build bc, info, FieldAtM: - preprocess(c, bc, t, arg, flags+{WantAddr}) - bc.add info, ImmediateValM, uint32(offset) - else: - let offset = bc.offsets[t[typ].typeId][t[b].immediateVal][0] - build bc, info, FieldAtM: - preprocess(c, bc, t, a, flags+{WantAddr}) - bc.add info, ImmediateValM, uint32(offset) + let offset = bc.offsets[t[typ].typeId][t[b].immediateVal][0] + build bc, info, FieldAtM: + preprocess(c, bc, t, a, flags+{WantAddr}) + bc.add info, ImmediateValM, uint32(offset) + of DerefFieldAt: + let (typ, a, b) = sons3(t, n) + let offset = bc.offsets[t[typ].typeId][t[b].immediateVal][0] + build bc, info, DerefFieldAtM: + preprocess(c, bc, t, a, flags+{WantAddr}) + bc.add info, ImmediateValM, uint32(offset) of Load: let (elemType, a) = sons2(t, n) let tid = t[elemType].typeId @@ -776,6 +769,10 @@ proc evalAddr(c: Bytecode; pc: CodePos; s: StackFrame): pointer = let (x, offset) = sons2(c.code, pc) result = evalAddr(c, x, s) result = result +! c.code[offset].operand + of DerefFieldAtM: + let (x, offset) = sons2(c.code, pc) + let p = evalAddr(c, x, s) + result = cast[ptr pointer](p)[] +! c.code[offset].operand of ArrayAtM: let (e, a, i) = sons3(c.code, pc) let elemSize = c.code[e].operand @@ -783,6 +780,13 @@ proc evalAddr(c: Bytecode; pc: CodePos; s: StackFrame): pointer = var idx: int = 0 eval(c, i, s, addr idx, sizeof(int)) result = result +! (uint32(idx) * elemSize) + of DerefArrayAtM: + let (e, a, i) = sons3(c.code, pc) + let elemSize = c.code[e].operand + var p = evalAddr(c, a, s) + var idx: int = 0 + eval(c, i, s, addr idx, sizeof(int)) + result = cast[ptr pointer](p)[] +! (uint32(idx) * elemSize) of LoadM: let (_, arg) = sons2(c.code, pc) let p = evalAddr(c, arg, s) @@ -934,7 +938,7 @@ proc eval(c: Bytecode; pc: CodePos; s: StackFrame; result: pointer; size: int) = of LoadLocalM: let dest = s.locals +! c.code[pc].operand copyMem dest, result, size - of FieldAtM, ArrayAtM, LoadM, LoadGlobalM: + of FieldAtM, DerefFieldAtM, ArrayAtM, DerefArrayAtM, LoadM, LoadGlobalM: let dest = evalAddr(c, pc, s) copyMem dest, result, size of LoadProcM: @@ -1042,12 +1046,19 @@ proc evalBuiltin(c: Bytecode; pc: CodePos; s: StackFrame; prc: CodePos; didEval: case c[prc].kind of PragmaPairM: let (x, y) = sons2(c.code, prc) - if cast[PragmaKey](c[x].operand) == CoreName: + let key = cast[PragmaKey](c[x].operand) + case key + of CoreName: let lit = c[y].litId case c.m.lit.strings[lit] of "echoBinSafe": echoImpl(c, pc, s) - else: discard + else: + raiseAssert "cannot eval: " & c.m.lit.strings[lit] didEval = true + of HeaderImport, DllImport: + let lit = c[y].litId + raiseAssert "cannot eval: " & c.m.lit.strings[lit] + else: discard of PragmaIdM, AllocLocals: discard else: break next c, prc From 2afea573d1a8401ce1629b64cfe1f26917779808 Mon Sep 17 00:00:00 2001 From: Araq Date: Tue, 31 Oct 2023 11:26:05 +0100 Subject: [PATCH 04/10] string literals should now be correct --- compiler/nir/nirvm.nim | 31 +++++++++++++++++++++---------- 1 file changed, 21 insertions(+), 10 deletions(-) diff --git a/compiler/nir/nirvm.nim b/compiler/nir/nirvm.nim index 097cd743ec5f8..d53c27a5b895e 100644 --- a/compiler/nir/nirvm.nim +++ b/compiler/nir/nirvm.nim @@ -109,6 +109,14 @@ template toIns(k: OpcodeM; operand: uint32): Instr = template toIns(k: OpcodeM; operand: LitId): Instr = Instr(uint32(k) or (operand.uint32 shl OpcodeBits)) +type + NimStrPayloadVM = object + cap: int + data: UncheckedArray[char] + NimStringVM = object + len: int + p: ptr NimStrPayloadVM + const GlobalsSize = 1024*24 @@ -122,6 +130,7 @@ type m: ref NirModule procs: Table[SymId, CodePos] globals: Table[SymId, uint32] + strings: Table[LitId, NimStringVM] globalData: pointer globalsAddr: uint32 typeImpls: Table[string, TypeId] @@ -393,6 +402,14 @@ template maybeDeref(doDeref: bool; body: untyped) = if doDeref: patch(bc, pos) +proc toReadonlyString(s: string): NimStringVM = + if s.len == 0: + result = NimStringVM(len: 0, p: nil) + else: + result = NimStringVM(len: s.len, p: cast[ptr NimStrPayloadVM](alloc(s.len+1+sizeof(int)))) + copyMem(addr result.p.data[0], addr s[0], s.len+1) + result.p.cap = s.len or (1 shl (8 * 8 - 2)) # see also NIM_STRLIT_FLAG + const ForwardedProc = 10_000_000'u32 @@ -411,6 +428,9 @@ proc preprocess(c: var Preprocessing; bc: var Bytecode; t: Tree; n: NodePos; fla of IntVal: bc.add info, IntValM, t[n].rawOperand of StrVal: + let litId = LitId t[n].rawOperand + if not bc.strings.hasKey(litId): + bc.strings[litId] = toReadonlyString(bc.m.lit.strings[litId]) bc.add info, StrValM, t[n].rawOperand of SymDef: discard "happens for proc decls. Don't copy the node as we don't need it" @@ -965,8 +985,7 @@ proc eval(c: Bytecode; pc: CodePos; s: StackFrame; result: pointer; size: int) = of StrValM: # binary compatible and no deep copy required: - copyMem(cast[ptr string](result), addr(c.m.lit.strings[c[pc].litId]), sizeof(string)) - # XXX not correct! + copyMem(cast[ptr string](result), addr(c.strings[c[pc].litId]), sizeof(string)) of ObjConstrM: for offset, size, val in triples(c, pc): eval c, val, s, result+!offset, size @@ -1020,14 +1039,6 @@ proc evalProc(c: Bytecode; pc: CodePos; s: StackFrame): CodePos = assert procSym < ForwardedProc result = CodePos(procSym) -type - NimStrPayloadVM = object - cap: int - data: UncheckedArray[char] - NimStringVM = object - len: int - p: ptr NimStrPayloadVM - proc echoImpl(c: Bytecode; pc: CodePos; frame: StackFrame) = var s = default(NimStringVM) for a in sonsFrom1(c, pc): From b03405eb90cfc279cd2af2c78d8275229078ec53 Mon Sep 17 00:00:00 2001 From: Araq Date: Tue, 31 Oct 2023 12:36:28 +0100 Subject: [PATCH 05/10] bugfixes --- compiler/modulegraphs.nim | 1 + compiler/nir/nir.nim | 1 + compiler/nir/nirvm.nim | 35 ++++++++++++++++++----------------- compiler/pipelines.nim | 3 ++- 4 files changed, 22 insertions(+), 18 deletions(-) diff --git a/compiler/modulegraphs.nim b/compiler/modulegraphs.nim index 325c0adb1d5f8..ba636eb5a16d1 100644 --- a/compiler/modulegraphs.nim +++ b/compiler/modulegraphs.nim @@ -92,6 +92,7 @@ type importDeps*: Table[FileIndex, seq[FileIndex]] # explicit import module dependencies suggestMode*: bool # whether we are in nimsuggest mode or not. invalidTransitiveClosure: bool + interactive*: bool inclToMod*: Table[FileIndex, FileIndex] # mapping of include file to the # first module that included it importStack*: seq[FileIndex] # The current import stack. Used for detecting recursive diff --git a/compiler/nir/nir.nim b/compiler/nir/nir.nim index 1efa6719a11ac..6f7077fb058c1 100644 --- a/compiler/nir/nir.nim +++ b/compiler/nir/nir.nim @@ -57,6 +57,7 @@ proc evalStmt(c: PCtx; n: PNode) = #res.add "\n--------------------------\n" #toString res, c.m.types.g if pc.int < c.m.nirm.code.len: + c.bytecode.interactive = c.m.graph.interactive execCode c.bytecode, c.m.nirm.code, pc #echo res diff --git a/compiler/nir/nirvm.nim b/compiler/nir/nirvm.nim index d53c27a5b895e..8721e337ad4c1 100644 --- a/compiler/nir/nirvm.nim +++ b/compiler/nir/nirvm.nim @@ -138,6 +138,7 @@ type sizes: Table[TypeId, (int, int)] # (size, alignment) oldTypeLen: int procUsagesToPatch: Table[SymId, seq[CodePos]] + interactive*: bool Universe* = object ## all units: For interpretation we need that units: seq[Bytecode] @@ -443,7 +444,7 @@ proc preprocess(c: var Preprocessing; bc: var Bytecode; t: Tree; n: NodePos; fla bc.add info, LoadProcM, uint32 bc.procs[s] elif bc.globals.hasKey(s): maybeDeref(WantAddr notin flags): - bc.add info, LoadGlobalM, uint32 s + bc.add info, LoadGlobalM, bc.globals[s] else: let here = CodePos(bc.code.len) bc.add info, LoadProcM, ForwardedProc + uint32(s) @@ -956,11 +957,11 @@ proc evalSelect(c: Bytecode; pc: CodePos; s: StackFrame): CodePos = proc eval(c: Bytecode; pc: CodePos; s: StackFrame; result: pointer; size: int) = case c.code[pc].kind of LoadLocalM: - let dest = s.locals +! c.code[pc].operand - copyMem dest, result, size + let src = s.locals +! c.code[pc].operand + copyMem result, src, size of FieldAtM, DerefFieldAtM, ArrayAtM, DerefArrayAtM, LoadM, LoadGlobalM: - let dest = evalAddr(c, pc, s) - copyMem dest, result, size + let src = evalAddr(c, pc, s) + copyMem result, src, size of LoadProcM: let procAddr = c.code[pc].operand cast[ptr pointer](result)[] = cast[pointer](procAddr) @@ -1077,37 +1078,37 @@ proc evalBuiltin(c: Bytecode; pc: CodePos; s: StackFrame; prc: CodePos; didEval: proc exec(c: Bytecode; pc: CodePos; u: ref Universe) = var pc = pc - var s = StackFrame(u: u) + var frame = StackFrame(u: u) while pc.int < c.code.len: case c.code[pc].kind of GotoM: pc = CodePos(c.code[pc].operand) of AsgnM: let (sz, a, b) = sons3(c.code, pc) - let dest = evalAddr(c, a, s) - eval(c, b, s, dest, c.code[sz].operand.int) + let dest = evalAddr(c, a, frame) + eval(c, b, frame, dest, c.code[sz].operand.int) next c, pc of StoreM: let (sz, a, b) = sons3(c.code, pc) - let destPtr = evalAddr(c, a, s) + let destPtr = evalAddr(c, a, frame) let dest = cast[ptr pointer](destPtr)[] - eval(c, b, s, dest, c.code[sz].operand.int) + eval(c, b, frame, dest, c.code[sz].operand.int) next c, pc of CallM: # No support for return values, these are mapped to `var T` parameters! - var prc = evalProc(c, pc.firstSon, s) + var prc = evalProc(c, pc.firstSon, frame) assert c.code[prc.firstSon].kind == AllocLocals let frameSize = int c.code[prc.firstSon].operand # skip stupid stuff: var didEval = false - prc = evalBuiltin(c, pc, s, prc.firstSon, didEval) + prc = evalBuiltin(c, pc, frame, prc.firstSon, didEval) if didEval: next c, pc else: # setup storage for the proc already: let callInstr = pc next c, pc - let s2 = newStackFrame(frameSize, s, pc) + let s2 = newStackFrame(frameSize, frame, pc) for a in sonsFrom1(c, callInstr): assert c[prc].kind == SummonParamM let paramAddr = c[prc].operand @@ -1116,13 +1117,13 @@ proc exec(c: Bytecode; pc: CodePos; u: ref Universe) = let paramSize = c[prc].operand.int next c, prc eval(c, a, s2, s2.locals +! paramAddr, paramSize) - s = s2 + frame = s2 pc = prc of RetM: - pc = s.returnAddr - s = popStackFrame(s) + pc = frame.returnAddr + frame = popStackFrame(frame) of SelectM: - let pc2 = evalSelect(c, pc, s) + let pc2 = evalSelect(c, pc, frame) if pc2.int >= 0: pc = pc2 else: diff --git a/compiler/pipelines.nim b/compiler/pipelines.nim index e4c484e1f3286..8f40ac031da7f 100644 --- a/compiler/pipelines.nim +++ b/compiler/pipelines.nim @@ -148,9 +148,10 @@ proc processPipelineModule*(graph: ModuleGraph; module: PSym; idgen: IdGenerator if s == nil: rawMessage(graph.config, errCannotOpenFile, filename.string) return false + graph.interactive = false else: s = stream - + graph.interactive = stream.kind == llsStdIn while true: syntaxes.openParser(p, fileIdx, s, graph.cache, graph.config) From 083222a42d72924fdfab5ef793f56948f3a6b37a Mon Sep 17 00:00:00 2001 From: Araq Date: Tue, 31 Oct 2023 14:22:25 +0100 Subject: [PATCH 06/10] progress --- compiler/nir/ast2ir.nim | 15 +++++-------- compiler/nir/nirinsts.nim | 6 +++--- compiler/nir/nirvm.nim | 44 ++++++++++++++++++++++++++------------- 3 files changed, 38 insertions(+), 27 deletions(-) diff --git a/compiler/nir/ast2ir.nim b/compiler/nir/ast2ir.nim index 4786919861240..cb23c84a33a8f 100644 --- a/compiler/nir/ast2ir.nim +++ b/compiler/nir/ast2ir.nim @@ -311,8 +311,7 @@ proc tempToDest(c: var ProcCon; n: PNode; d: var Value; tmp: Value) = d = tmp else: let info = toLineInfo(c, n.info) - build c.code, info, Asgn: - c.code.addTyped info, typeToIr(c.m, n.typ) + buildTyped c.code, info, Asgn, typeToIr(c.m, n.typ): c.code.copyTree d c.code.copyTree tmp freeTemp(c, tmp) @@ -406,8 +405,7 @@ proc genCase(c: var ProcCon; n: PNode; d: var Value) = let ending = newLabel(c.labelGen) let info = toLineInfo(c, n.info) withTemp(tmp, n[0]): - build c.code, info, Select: - c.code.addTyped info, typeToIr(c.m, n[0].typ) + buildTyped c.code, info, Select, typeToIr(c.m, n[0].typ): c.gen(n[0], tmp) for i in 1.. LastAtomicValue let last = pos + tree.nodes[pos].rawSpan inc pos - nextChild tree, pos - nextChild tree, pos + for i in 1..toSkip: + nextChild tree, pos while pos < last: yield NodePos pos nextChild tree, pos diff --git a/compiler/nir/nirvm.nim b/compiler/nir/nirvm.nim index 1f39952f0c499..0520a20502271 100644 --- a/compiler/nir/nirvm.nim +++ b/compiler/nir/nirvm.nim @@ -62,7 +62,6 @@ type CheckedIndexM, CallM, - CheckedCallM, # call that can raise CheckedAddM, # with overflow checking etc. CheckedSubM, CheckedMulM, @@ -609,12 +608,14 @@ proc preprocess(c: var Preprocessing; bc: var Bytecode; t: Tree; n: NodePos; fla build bc, info, CallM: preprocess(c, bc, t, src.skipTyped, {WantAddr}) preprocess(c, bc, t, dest, {WantAddr}) - for ch in sonsFrom2(t, src): preprocess(c, bc, t, ch, {WantAddr}) + for ch in sonsFromN(t, src, 2): preprocess(c, bc, t, ch, {WantAddr}) elif t[src].kind in {CheckedCall, CheckedIndirectCall}: - build bc, info, CheckedCallM: - preprocess(c, bc, t, src.skipTyped, {WantAddr}) + let (_, gotoInstr, fn) = sons3(t, src) + build bc, info, CallM: + preprocess(c, bc, t, fn, {WantAddr}) preprocess(c, bc, t, dest, {WantAddr}) - for ch in sonsFrom2(t, src): preprocess(c, bc, t, ch, {WantAddr}) + for ch in sonsFromN(t, src, 3): preprocess(c, bc, t, ch, {WantAddr}) + preprocess c, bc, t, gotoInstr, {} elif t[dest].kind == Load: let (typ, a) = sons2(t, dest) let s = computeSize(bc, tid)[0] @@ -642,8 +643,11 @@ proc preprocess(c: var Preprocessing; bc: var Bytecode; t: Tree; n: NodePos; fla for ch in sonsFrom1(t, n): preprocess(c, bc, t, ch, {WantAddr}) of CheckedCall, CheckedIndirectCall: # avoid the Typed thing at position 0: - build bc, info, CheckedCallM: - for ch in sonsFrom1(t, n): preprocess(c, bc, t, ch, {WantAddr}) + let (_, gotoInstr, fn) = sons3(t, n) + build bc, info, CallM: + preprocess(c, bc, t, fn, {WantAddr}) + for ch in sonsFromN(t, n, 3): preprocess(c, bc, t, ch, {WantAddr}) + preprocess c, bc, t, gotoInstr, {WantAddr} of CheckedAdd: recurse CheckedAddM of CheckedSub: @@ -1052,7 +1056,11 @@ proc echoImpl(c: Bytecode; pc: CodePos; frame: StackFrame) = stdout.write "\n" stdout.flushFile() -proc evalBuiltin(c: Bytecode; pc: CodePos; s: StackFrame; prc: CodePos; didEval: var bool): CodePos = +type + EvalBuiltinState = enum + DidNothing, DidEval, DidError + +proc evalBuiltin(c: Bytecode; pc: CodePos; s: StackFrame; prc: CodePos; state: var EvalBuiltinState): CodePos = var prc = prc while true: case c[prc].kind @@ -1066,7 +1074,7 @@ proc evalBuiltin(c: Bytecode; pc: CodePos; s: StackFrame; prc: CodePos; didEval: of "echoBinSafe": echoImpl(c, pc, s) else: raiseAssert "cannot eval: " & c.m.lit.strings[lit] - didEval = true + state = DidEval of HeaderImport, DllImport: let lit = c[y].litId raiseAssert "cannot eval: " & c.m.lit.strings[lit] @@ -1100,10 +1108,15 @@ proc exec(c: Bytecode; pc: CodePos; u: ref Universe) = assert c.code[prc.firstSon].kind == AllocLocals let frameSize = int c.code[prc.firstSon].operand # skip stupid stuff: - var didEval = false - prc = evalBuiltin(c, pc, frame, prc.firstSon, didEval) - if didEval: + var evalState = DidNothing + prc = evalBuiltin(c, pc, frame, prc.firstSon, evalState) + if evalState != DidNothing: next c, pc + if pc.int < c.code.len and c.code[pc].kind == CheckedGotoM: + if evalState == DidEval: + next c, pc + else: + pc = CodePos(c.code[pc].operand) else: # setup storage for the proc already: let callInstr = pc @@ -1121,6 +1134,8 @@ proc exec(c: Bytecode; pc: CodePos; u: ref Universe) = pc = prc of RetM: pc = frame.returnAddr + if c.code[pc].kind == CheckedGotoM: + pc = frame.jumpTo frame = popStackFrame(frame) of SelectM: let pc2 = evalSelect(c, pc, frame) @@ -1140,8 +1155,9 @@ proc execCode*(bc: var Bytecode; t: Tree; n: NodePos) = let start = CodePos(bc.code.len) var pc = n while pc.int < t.len: - #echo "RUnning: " - #debug bc, t, pc + #if bc.interactive: + # echo "RUnning: " + # debug bc, t, pc preprocess c, bc, t, pc, {} next t, pc exec bc, start, nil From d248f95207b573508d85eb37e467b8f040226714 Mon Sep 17 00:00:00 2001 From: Araq Date: Tue, 31 Oct 2023 15:54:41 +0100 Subject: [PATCH 07/10] progress --- compiler/nir/nirvm.nim | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/compiler/nir/nirvm.nim b/compiler/nir/nirvm.nim index 0520a20502271..e137379f51c5c 100644 --- a/compiler/nir/nirvm.nim +++ b/compiler/nir/nirvm.nim @@ -128,7 +128,7 @@ type debug: seq[PackedLineInfo] m: ref NirModule procs: Table[SymId, CodePos] - globals: Table[SymId, uint32] + globals: Table[SymId, (uint32, int)] strings: Table[LitId, NimStringVM] globalData: pointer globalsAddr: uint32 @@ -372,7 +372,7 @@ type u: ref Universe known: Table[LabelId, CodePos] toPatch: Table[LabelId, seq[CodePos]] - locals: Table[SymId, uint32] + locals: Table[SymId, (uint32, int)] # address, size thisModule: uint32 localsAddr: uint32 markedWithLabel: IntSet @@ -393,11 +393,11 @@ type AddrMode = enum InDotExpr, WantAddr -template maybeDeref(doDeref: bool; body: untyped) = +template maybeDeref(doDeref: bool; size: int; body: untyped) = var pos = PatchPos(-1) if doDeref: pos = prepare(bc, info, LoadM) - bc.add info, TypedM, 0'u32 + bc.add info, ImmediateValM, uint32 size body if doDeref: patch(bc, pos) @@ -437,13 +437,15 @@ proc preprocess(c: var Preprocessing; bc: var Bytecode; t: Tree; n: NodePos; fla of SymUse: let s = t[n].symId if c.locals.hasKey(s): - maybeDeref(WantAddr notin flags): - bc.add info, LoadLocalM, c.locals[s] + let (address, size) = c.locals[s] + maybeDeref(WantAddr notin flags, size): + bc.add info, LoadLocalM, address elif bc.procs.hasKey(s): bc.add info, LoadProcM, uint32 bc.procs[s] elif bc.globals.hasKey(s): - maybeDeref(WantAddr notin flags): - bc.add info, LoadGlobalM, bc.globals[s] + let (address, size) = bc.globals[s] + maybeDeref(WantAddr notin flags, size): + bc.add info, LoadGlobalM, address else: let here = CodePos(bc.code.len) bc.add info, LoadProcM, ForwardedProc + uint32(s) @@ -528,7 +530,7 @@ proc preprocess(c: var Preprocessing; bc: var Bytecode; t: Tree; n: NodePos; fla let (size, alignment) = computeSize(bc, tid) let global = align(bc.globalsAddr, uint32 alignment) - bc.globals[s] = global + bc.globals[s] = (global, size) bc.globalsAddr += uint32 size assert bc.globalsAddr < GlobalsSize @@ -540,7 +542,7 @@ proc preprocess(c: var Preprocessing; bc: var Bytecode; t: Tree; n: NodePos; fla let (size, alignment) = computeSize(bc, tid) let local = align(c.localsAddr, uint32 alignment) - c.locals[s] = local + c.locals[s] = (local, size) c.localsAddr += uint32 size # allocation is combined into the frame allocation so there is no # instruction to emit @@ -552,7 +554,7 @@ proc preprocess(c: var Preprocessing; bc: var Bytecode; t: Tree; n: NodePos; fla let (size, alignment) = computeSize(bc, tid) let local = align(c.localsAddr, uint32 alignment) - c.locals[s] = local + c.locals[s] = (local, size) c.localsAddr += uint32 size bc.add info, SummonParamM, local bc.add info, ImmediateValM, uint32 size From e46fef30dc43b746ac187eedec98f5beef0b5077 Mon Sep 17 00:00:00 2001 From: Araq Date: Tue, 31 Oct 2023 16:58:11 +0100 Subject: [PATCH 08/10] progress --- compiler/nir/ast2ir.nim | 16 ++++++------ compiler/nir/nirinsts.nim | 7 ++--- compiler/nir/nirvm.nim | 54 +++++++++++++++++++++++---------------- 3 files changed, 44 insertions(+), 33 deletions(-) diff --git a/compiler/nir/ast2ir.nim b/compiler/nir/ast2ir.nim index cb23c84a33a8f..d6772cf97f1e1 100644 --- a/compiler/nir/ast2ir.nim +++ b/compiler/nir/ast2ir.nim @@ -205,7 +205,7 @@ proc xjmp(c: var ProcCon; n: PNode; jk: JmpKind; v: Value): LabelId = c.code.copyTree Tree(v) build c.code, info, SelectPair: build c.code, info, SelectValue: - c.code.boolVal(info, jk == opcTJmp) + c.code.boolVal(c.lit.numbers, info, jk == opcTJmp) c.code.gotoLabel info, Goto, result proc patch(c: var ProcCon; n: PNode; L: LabelId) = @@ -361,7 +361,7 @@ template buildCond(useNegation: bool; cond: typed; body: untyped) = c.code.copyTree cond build c.code, info, SelectPair: build c.code, info, SelectValue: - c.code.boolVal(info, useNegation) + c.code.boolVal(c.lit.numbers, info, useNegation) c.code.gotoLabel info, Goto, lab body @@ -380,7 +380,7 @@ template buildIfThenElse(cond: typed; then, otherwise: untyped) = c.code.copyTree cond build c.code, info, SelectPair: build c.code, info, SelectValue: - c.code.boolVal(info, false) + c.code.boolVal(c.lit.numbers, info, false) c.code.gotoLabel info, Goto, lelse then() @@ -969,7 +969,7 @@ proc genInSet(c: var ProcCon; n: PNode; d: var Value) = if ex == nil: let info = toLineInfo(c, n.info) template body(target) = - boolVal target, info, false + boolVal target, c.lit.numbers, info, false intoDest d, info, Bool8Id, body else: gen c, ex, d @@ -1057,7 +1057,7 @@ proc beginCountLoop(c: var ProcCon; info: PackedLineInfo; first, last: int): (Sy c.code.addIntVal c.lit.numbers, info, c.m.nativeIntId, last build c.code, info, SelectPair: build c.code, info, SelectValue: - c.code.boolVal(info, false) + c.code.boolVal(c.lit.numbers, info, false) c.code.gotoLabel info, Goto, result[2] proc beginCountLoop(c: var ProcCon; info: PackedLineInfo; first, last: Value): (SymId, LabelId, LabelId) = @@ -1075,7 +1075,7 @@ proc beginCountLoop(c: var ProcCon; info: PackedLineInfo; first, last: Value): ( copyTree c.code, last build c.code, info, SelectPair: build c.code, info, SelectValue: - c.code.boolVal(info, false) + c.code.boolVal(c.lit.numbers, info, false) c.code.gotoLabel info, Goto, result[2] proc endLoop(c: var ProcCon; info: PackedLineInfo; s: SymId; back, exit: LabelId) = @@ -1121,7 +1121,7 @@ proc genLeSet(c: var ProcCon; n: PNode; d: var Value) = c.code.copyTree d build c.code, info, SelectPair: build c.code, info, SelectValue: - c.code.boolVal(info, false) + c.code.boolVal(c.lit.numbers, info, false) c.code.gotoLabel info, Goto, endLabel endLoop(c, info, idx, backLabel, endLabel) @@ -1534,7 +1534,7 @@ proc genMove(c: var ProcCon; n: PNode; d: var Value) = build c.code, info, SelectPair: build c.code, info, SelectValue: - c.code.boolVal(info, true) + c.code.boolVal(c.lit.numbers, info, true) c.code.gotoLabel info, Goto, lab1 gen(c, n[3]) diff --git a/compiler/nir/nirinsts.nim b/compiler/nir/nirinsts.nim index 0c024f6297f61..5c29015403961 100644 --- a/compiler/nir/nirinsts.nim +++ b/compiler/nir/nirinsts.nim @@ -344,9 +344,6 @@ proc addNewLabel*(t: var Tree; labelGen: var int; info: PackedLineInfo; k: Opcod t.nodes.add Instr(x: toX(k, uint32(result)), info: info) inc labelGen -proc boolVal*(t: var Tree; info: PackedLineInfo; b: bool) = - t.nodes.add Instr(x: toX(ImmediateVal, uint32(b)), info: info) - proc gotoLabel*(t: var Tree; info: PackedLineInfo; k: Opcode; L: LabelId) = assert k in {Goto, GotoLoop, CheckedGoto} t.nodes.add Instr(x: toX(k, uint32(L)), info: info) @@ -384,6 +381,10 @@ proc addIntVal*(t: var Tree; integers: var BiTable[int64]; info: PackedLineInfo; buildTyped t, info, NumberConv, typ: t.nodes.add Instr(x: toX(IntVal, uint32(integers.getOrIncl(x))), info: info) +proc boolVal*(t: var Tree; integers: var BiTable[int64]; info: PackedLineInfo; b: bool) = + buildTyped t, info, NumberConv, Bool8Id: + t.nodes.add Instr(x: toX(IntVal, uint32(integers.getOrIncl(ord b))), info: info) + proc addStrVal*(t: var Tree; strings: var BiTable[string]; info: PackedLineInfo; s: string) = t.nodes.add Instr(x: toX(StrVal, uint32(strings.getOrIncl(s))), info: info) diff --git a/compiler/nir/nirvm.nim b/compiler/nir/nirvm.nim index e137379f51c5c..d17c603f6d2a0 100644 --- a/compiler/nir/nirvm.nim +++ b/compiler/nir/nirvm.nim @@ -814,10 +814,6 @@ proc evalAddr(c: Bytecode; pc: CodePos; s: StackFrame): pointer = var idx: int = 0 eval(c, i, s, addr idx, sizeof(int)) result = cast[ptr pointer](p)[] +! (uint32(idx) * elemSize) - of LoadM: - let (_, arg) = sons2(c.code, pc) - let p = evalAddr(c, arg, s) - result = cast[ptr pointer](p)[] of LoadGlobalM: result = c.globalData +! c.code[pc].operand else: @@ -928,23 +924,29 @@ proc evalSelect(c: Bytecode; pc: CodePos; s: StackFrame): CodePos = for pair in sonsFrom2(c, pc): assert c.code[pair].kind == SelectPairM let (values, action) = sons2(c.code, pair) - assert c.code[values].kind == SelectListM - for v in sons(c, values): - case c.code[v].kind - of SelectValueM: - var a = default(typ) - eval c, v.firstSon, s, addr a, sizeof(typ) - if selector == a: - return CodePos c.code[action].operand - of SelectRangeM: - let (va, vb) = sons2(c.code, v) - var a = default(typ) - eval c, va, s, addr a, sizeof(typ) - var b = default(typ) - eval c, vb, s, addr a, sizeof(typ) - if a <= selector and selector <= b: - return CodePos c.code[action].operand - else: raiseAssert "unreachable" + if c.code[values].kind == SelectValueM: + var a = default(typ) + eval c, values.firstSon, s, addr a, sizeof(typ) + if selector == a: + return CodePos c.code[action].operand + else: + assert c.code[values].kind == SelectListM, $c.code[values].kind + for v in sons(c, values): + case c.code[v].kind + of SelectValueM: + var a = default(typ) + eval c, v.firstSon, s, addr a, sizeof(typ) + if selector == a: + return CodePos c.code[action].operand + of SelectRangeM: + let (va, vb) = sons2(c.code, v) + var a = default(typ) + eval c, va, s, addr a, sizeof(typ) + var b = default(typ) + eval c, vb, s, addr a, sizeof(typ) + if a <= selector and selector <= b: + return CodePos c.code[action].operand + else: raiseAssert "unreachable" result = CodePos(-1) let (t, sel) = sons2(c.code, pc) @@ -965,12 +967,16 @@ proc eval(c: Bytecode; pc: CodePos; s: StackFrame; result: pointer; size: int) = of LoadLocalM: let src = s.locals +! c.code[pc].operand copyMem result, src, size - of FieldAtM, DerefFieldAtM, ArrayAtM, DerefArrayAtM, LoadM, LoadGlobalM: + of FieldAtM, DerefFieldAtM, ArrayAtM, DerefArrayAtM, LoadGlobalM: let src = evalAddr(c, pc, s) copyMem result, src, size of LoadProcM: let procAddr = c.code[pc].operand cast[ptr pointer](result)[] = cast[pointer](procAddr) + of LoadM: + let (_, arg) = sons2(c.code, pc) + let src = evalAddr(c, arg, s) + copyMem result, src, size of CheckedAddM: checkedBinop `+` of CheckedSubM: checkedBinop `-` of CheckedMulM: checkedBinop `*` @@ -1090,6 +1096,10 @@ proc exec(c: Bytecode; pc: CodePos; u: ref Universe) = var pc = pc var frame = StackFrame(u: u) while pc.int < c.code.len: + when false: # c.interactive: + echo "running: " + debug c, pc + case c.code[pc].kind of GotoM: pc = CodePos(c.code[pc].operand) From ec90b107d1b694e7f1a4f17d9e4db68349937687 Mon Sep 17 00:00:00 2001 From: Araq Date: Tue, 31 Oct 2023 18:55:39 +0100 Subject: [PATCH 09/10] fixes the positions of CheckedGoto --- compiler/nir/ast2ir.nim | 25 ++++++++++++++----------- 1 file changed, 14 insertions(+), 11 deletions(-) diff --git a/compiler/nir/ast2ir.nim b/compiler/nir/ast2ir.nim index d6772cf97f1e1..ad04dc103d217 100644 --- a/compiler/nir/ast2ir.nim +++ b/compiler/nir/ast2ir.nim @@ -578,10 +578,10 @@ proc genIndex(c: var ProcCon; n: PNode; arr: PType; d: var Value) = if optBoundsCheck in c.options: let idx = move d build d, info, CheckedIndex: + d.Tree.addLabel info, CheckedGoto, c.exitLabel copyTree d.Tree, idx let x = toInt64 lengthOrd(c.config, arr) d.addIntVal c.lit.numbers, info, c.m.nativeIntId, x - d.Tree.addLabel info, CheckedGoto, c.exitLabel proc rawGenNew(c: var ProcCon; d: Value; refType: PType; ninfo: TLineInfo; needsInit: bool) = assert refType.kind == tyRef @@ -710,7 +710,7 @@ proc genBinaryOp(c: var ProcCon; n: PNode; d: var Value; opc: Opcode) = let t = typeToIr(c.m, n.typ) template body(target) = buildTyped target, info, opc, t: - if optOverflowCheck in c.options and opc in {CheckedAdd, CheckedSub, CheckedMul, CheckedDiv, CheckedMod}: + if opc in {CheckedAdd, CheckedSub, CheckedMul, CheckedDiv, CheckedMod}: target.addLabel info, CheckedGoto, c.exitLabel copyTree target, tmp copyTree target, tmp2 @@ -751,6 +751,8 @@ proc genIncDec(c: var ProcCon; n: PNode; opc: Opcode) = buildTyped c.code, info, Asgn, t: copyTree c.code, d buildTyped c.code, info, opc, t: + if opc in {CheckedAdd, CheckedSub}: + c.code.addLabel info, CheckedGoto, c.exitLabel copyTree c.code, d copyTree c.code, tmp c.freeTemp(tmp) @@ -1457,6 +1459,7 @@ proc genStrConcat(c: var ProcCon; n: PNode; d: var Value) = buildTyped c.code, info, Asgn, c.m.nativeIntId: c.code.addSymUse info, tmpLen buildTyped c.code, info, CheckedAdd, c.m.nativeIntId: + c.code.addLabel info, CheckedGoto, c.exitLabel c.code.addSymUse info, tmpLen buildTyped c.code, info, FieldAt, typeToIr(c.m, n.typ): copyTree c.code, a @@ -1631,6 +1634,7 @@ proc genIndexCheck(c: var ProcCon; n: PNode; a: Value; kind: IndexFor; arr: PTyp result = default(Value) let idx = genx(c, n) build result, info, CheckedIndex: + result.Tree.addLabel info, CheckedGoto, c.exitLabel copyTree result.Tree, idx case kind of ForSeq, ForStr: @@ -1644,7 +1648,6 @@ proc genIndexCheck(c: var ProcCon; n: PNode; a: Value; kind: IndexFor; arr: PTyp of ForArray: let x = toInt64 lengthOrd(c.config, arr) result.addIntVal c.lit.numbers, info, c.m.nativeIntId, x - result.Tree.addLabel info, CheckedGoto, c.exitLabel freeTemp c, idx else: result = genx(c, n) @@ -1746,14 +1749,14 @@ proc genMagic(c: var ProcCon; n: PNode; d: var Value; m: TMagic) = case m of mAnd: c.genAndOr(n, opcFJmp, d) of mOr: c.genAndOr(n, opcTJmp, d) - of mPred, mSubI: c.genBinaryOp(n, d, CheckedSub) - of mSucc, mAddI: c.genBinaryOp(n, d, CheckedAdd) + of mPred, mSubI: c.genBinaryOp(n, d, if optOverflowCheck in c.options: CheckedSub else: Sub) + of mSucc, mAddI: c.genBinaryOp(n, d, if optOverflowCheck in c.options: CheckedAdd else: Add) of mInc: unused(c, n, d) - c.genIncDec(n, CheckedAdd) + c.genIncDec(n, if optOverflowCheck in c.options: CheckedAdd else: Add) of mDec: unused(c, n, d) - c.genIncDec(n, CheckedSub) + c.genIncDec(n, if optOverflowCheck in c.options: CheckedSub else: Sub) of mOrd, mChr, mUnown: c.gen(n[1], d) of generatedMagics: @@ -1768,9 +1771,9 @@ proc genMagic(c: var ProcCon; n: PNode; d: var Value; m: TMagic) = of mNewString, mNewStringOfCap, mExit: c.genCall(n, d) of mLengthOpenArray, mLengthArray, mLengthSeq, mLengthStr: genArrayLen(c, n, d) - of mMulI: genBinaryOp(c, n, d, CheckedMul) - of mDivI: genBinaryOp(c, n, d, CheckedDiv) - of mModI: genBinaryOp(c, n, d, CheckedMod) + of mMulI: genBinaryOp(c, n, d, if optOverflowCheck in c.options: CheckedMul else: Mul) + of mDivI: genBinaryOp(c, n, d, if optOverflowCheck in c.options: CheckedDiv else: Div) + of mModI: genBinaryOp(c, n, d, if optOverflowCheck in c.options: CheckedMod else: Mod) of mAddF64: genBinaryOp(c, n, d, Add) of mSubF64: genBinaryOp(c, n, d, Sub) of mMulF64: genBinaryOp(c, n, d, Mul) @@ -2238,10 +2241,10 @@ proc genRangeCheck(c: var ProcCon; n: PNode; d: var Value) = let b = c.genx n[2] template body(target) = buildTyped target, info, CheckedRange, typeToIr(c.m, n.typ): + target.addLabel info, CheckedGoto, c.exitLabel copyTree target, tmp copyTree target, a copyTree target, b - target.addLabel info, CheckedGoto, c.exitLabel valueIntoDest c, info, d, n.typ, body freeTemp c, tmp freeTemp c, a From 771690f89df74b42b67a3cd17a4a979c80748d5c Mon Sep 17 00:00:00 2001 From: Araq Date: Tue, 31 Oct 2023 20:03:25 +0100 Subject: [PATCH 10/10] another silly bugfix --- compiler/nir/nirvm.nim | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/nir/nirvm.nim b/compiler/nir/nirvm.nim index d17c603f6d2a0..a3d69a2962d35 100644 --- a/compiler/nir/nirvm.nim +++ b/compiler/nir/nirvm.nim @@ -476,7 +476,7 @@ proc preprocess(c: var Preprocessing; bc: var Bytecode; t: Tree; n: NodePos; fla bc.add info, NilValM, t[n].rawOperand of LoopLabel, Label: let lab = t[n].label - let here = CodePos(bc.code.len-1) + let here = CodePos(bc.code.len) c.known[lab] = here var p: seq[CodePos] = @[] if c.toPatch.take(lab, p): @@ -1097,7 +1097,7 @@ proc exec(c: Bytecode; pc: CodePos; u: ref Universe) = var frame = StackFrame(u: u) while pc.int < c.code.len: when false: # c.interactive: - echo "running: " + echo "running: ", pc.int debug c, pc case c.code[pc].kind