From 0fa6d3b68c4212ba15fd1d3205d46de280b7fe5b Mon Sep 17 00:00:00 2001 From: zerbina <100542850+zerbina@users.noreply.github.com> Date: Thu, 21 Dec 2023 23:24:42 +0000 Subject: [PATCH 01/11] vm: rework the exception handling Summary ======= Implement a different approach to exception handling in the VM, fixing many (all?) of the issues around `raise`, `except`, and `finally`. This makes the VM's exception handling implementation the most complete out of the existing backends. Details ======= Exception and `finally` handling was very incomplete, with many non- simple cases not working (e.g., `finally` not intercepting `break`s, the current exception not being reset once handled, etc.). **New exception handling implementation:** * instead of the safepoint-based approach (`opcTry`), a separate instruction-to-exception-handler lookup table is used * each call frame uses its own lookup table; setting the lookup table is done via the new `SetEh` instruction * the table stores mappings from instruction position to the position of special-purpose exception handling (=EH) instructions * when an instruction raises, it is looked up in the table. If no associated EH instruction is found, the call instruction in the above frame is looked up, then the call instruction in the frame, etc. * if no EH instruction is found even after unwinding the call stack, the exception is treated as unhandled and reported to the supervisor * if an EH instruction is found, an internal EH thread is spawned for the raised exception and the EH instruction(s) are executed * the EH instructions describe which `except` and `finally` clauses are visited and in what order * entering an `except` or `finally` clause from an EH thread sets the current exception (the one returned by `getCurrentException`) to the thread's associated exception This affords for a large amount of flexibility with exception handling. **New `finally` implementation:** * the `Finally` and `FinallyEnd` opcodes stay, but they now work differently * each finally section is associated with a *control register* * the control register stores the information necessary for knowing what to do when the end of the section (`FinallyEnd`) is reached * how execution continues at the end of a finally section depends on how the `Finally` instruction was reached: * if reached by normal control-flow, execution continues at the instruction designated by the `Finally` instruction * if reached via an `Enter` instruction, execution continues at the instruction following the `Enter` instruction * if reached from exception handling, the EH thread is resumed * jumping from outside a finally section to within one is forbidden The `Enter` and `Leave` are two new instructions: * `Enter` is used for redirecting to finally sections and works as described above * `Leave` is used for terminating open EH threads when exiting an `except` clause or when exiting a `finally` clause through unstructured control-flow (e.g., `break`) When a `break` or `return` exits one or more `try` clauses with attached `finally` clauses, `vmgen` emits an `Enter` instruction targeting each, prior to the final jump. Similarly, `vmgen` emits an `Leave` instruction for each `finally` and `except` clause exited through unstructured control-flow. Considered alternatives ----------------------- Much of the mentioned changes could have also been implemented on-top of the safe-point mechanism. This, however, would not allow supporting clean-up-only control-flow (that is, all exception handler being skipped and only certain finally section being executed), which, while not used at the moment, could in the future become useful for implementing panics. Code generator details ---------------------- * a `SetEh` instruction is always emitted, even if a code fragment / procedure, has no instruction-to-EH mappings. This is a temporary limitation * all `IndCall` and `IndCallAsgn` instructions (i.e., calls that weren't lowered into dedicated instruction) are treated as raising * the EH instructions are emitted together with the normal bytecode; no separate code generation pass is used Future direction ---------------- The MIR (and subsequently the `CgNode` IR) is planned to use goto- based control-flow primitives, similar to the ones that the VM uses. This means that much of the semantics-related decision-making (e.g., where to insert `Leave` instructions) is going to move out of `vmgen`. --- compiler/vm/packed_env.nim | 9 + compiler/vm/vm.nim | 404 +++++++++++++++++++------------------ compiler/vm/vm_enums.nim | 9 +- compiler/vm/vmbackend.nim | 2 + compiler/vm/vmdef.nim | 44 +++- compiler/vm/vmerrors.nim | 17 +- compiler/vm/vmgen.nim | 294 +++++++++++++++++++++++---- compiler/vm/vmjit.nim | 2 + compiler/vm/vmrunner.nim | 2 + compiler/vm/vmutils.nim | 6 +- 10 files changed, 542 insertions(+), 247 deletions(-) diff --git a/compiler/vm/packed_env.nim b/compiler/vm/packed_env.nim index 29c844da910..67aae1b0616 100644 --- a/compiler/vm/packed_env.nim +++ b/compiler/vm/packed_env.nim @@ -151,6 +151,8 @@ type code*: seq[TInstr] debug*: seq[uint32] # Packed version of `TCtx.debug`. Indices into `infos` + ehTable*: seq[HandlerTableEntry] + ehCode*: seq[EhInstr] # rtti related data: nimNodes: seq[PackedNodeLite] @@ -874,6 +876,9 @@ func storeEnv*(enc: var PackedEncoder, dst: var PackedEnv, c: TCtx) = mapList(dst.debug, c.debug, d): dst.infos.getOrIncl(d).uint32 + dst.ehTable = c.ehTable + dst.ehCode = c.ehCode + mapList(dst.files, c.config.m.fileInfos, fi): fi.fullPath.string @@ -906,6 +911,8 @@ proc writeToFile*(p: PackedEnv, file: AbsoluteFile): RodFileError = f.storePrim p.entryPoint f.storeSeq p.code f.storeSeq p.debug + f.storeSeq p.ehTable + f.storeSeq p.ehCode f.storeSection symsSection f.store p.infos @@ -948,6 +955,8 @@ proc readFromFile*(p: var PackedEnv, file: AbsoluteFile): RodFileError = f.loadPrim p.entryPoint f.loadSeq p.code f.loadSeq p.debug + f.loadSeq p.ehTable + f.loadSeq p.ehCode f.loadSection symsSection f.load p.infos diff --git a/compiler/vm/vm.nim b/compiler/vm/vm.nim index ed8b7316611..e2f656501af 100644 --- a/compiler/vm/vm.nim +++ b/compiler/vm/vm.nim @@ -82,6 +82,13 @@ import std/options as stdoptions from std/math import round, copySign type + VmException = object + ## Internal-only. + refVal: HeapSlotHandle + trace: VmRawStackTrace + # XXX: the trace should be stored in the exception object, which would + # also make it accessible to the guest (via ``getStackTrace``) + VmThread* = object ## This is beginning of splitting up ``TCtx``. A ``VmThread`` is ## meant to encapsulate the state that makes up a single execution. This @@ -92,15 +99,11 @@ type loopIterations: int ## the number of remaining jumps backwards - # exception state: currentException: HeapSlotHandle ## the exception ref that's returned when querying the current exception - activeException: HeapSlotHandle - ## the exception that is currently in-flight (i.e. being raised), or - ## nil, if none is in-flight. Note that `activeException` is different - ## from `currentException` - activeExceptionTrace: VmRawStackTrace - ## the stack-trace of where the exception was raised from + ehStack: seq[tuple[ex: VmException, pc: uint32]] + ## the stack of currently executed EH threads. A stack is needed since + ## exceptions can be raised while another exception is in flight YieldReasonKind* = enum yrkDone @@ -139,10 +142,15 @@ type const traceCode = defined(nimVMDebugExecute) + fromEhBit = cast[BiggestInt](0x8000_0000_0000_0000'u64) + ## the presence in a finally's control register signals that the finally + ## was entered as part of exception handling const errIllegalConvFromXtoY = "illegal conversion from '$1' to '$2'" +func `$`(x: VmException) {.error.} + proc createStackTrace*( c: TCtx, thread: VmThread, @@ -241,7 +249,7 @@ template toException(x: DerefFailureCode): untyped = ## `Result` -> exception translation toVmError(x, instLoc()) -proc reportException(c: TCtx; trace: VmRawStackTrace, raised: LocHandle) = +proc reportException(c: TCtx; trace: sink VmRawStackTrace, raised: LocHandle) = ## Reports the exception represented by `raised` by raising a `VmError` let name = $raised.getFieldHandle(1.fpos).deref().strVal @@ -476,141 +484,138 @@ proc regToNode*(c: TCtx, x: TFullReg; typ: PType, info: TLineInfo): PNode = of rkHandle, rkLocation: result = c.deserialize(x.handle, typ, info) of rkNimNode: result = x.nimNode -proc pushSafePoint(f: var TStackFrame; pc: int) = - f.safePoints.add(pc) - -proc popSafePoint(f: var TStackFrame) = - discard f.safePoints.pop() - -type - ExceptionGoto = enum - ExceptionGotoHandler, - ExceptionGotoFinally, - ExceptionGotoUnhandled - -proc findExceptionHandler(c: TCtx, f: var TStackFrame, raisedType: PVmType): - tuple[why: ExceptionGoto, where: int] = - - while f.safePoints.len > 0: - var pc = f.safePoints.pop() - - var matched = false - var pcEndExcept = pc - - # Scan the chain of exceptions starting at pc. - # The structure is the following: - # pc - opcExcept, - # - opcExcept, - # - opcExcept, - # ... - # - opcExcept, - # - Exception handler body - # - ... more opcExcept blocks may follow - # - ... an optional opcFinally block may follow - # - # Note that the exception handler body already contains a jump to the - # finally block or, if that's not present, to the point where the execution - # should continue. - # Also note that opcFinally blocks are the last in the chain. - while c.code[pc].opcode == opcExcept: - # Where this Except block ends - pcEndExcept = pc + c.code[pc].regBx - wordExcess - inc pc - - # A series of opcExcept follows for each exception type matched - while c.code[pc].opcode == opcExcept: - let excIndex = c.code[pc].regBx - wordExcess - let exceptType = - if excIndex > 0: c.types[excIndex] - else: nil - - # echo typeToString(exceptType), " ", typeToString(raisedType) - - # Determine if the exception type matches the pattern - if exceptType.isNil or getTypeRel(raisedType, exceptType) in {vtrSub, vtrSame}: - matched = true - break +# ---- exception handling ---- - inc pc +proc setCurrentException(t: var VmThread, mem: var VmMemoryManager, + ex: HeapSlotHandle) = + ## Sets `ex` as `t`'s current exception, freeing the previous exception, + ## if necessary. + mem.heap.heapIncRef(ex) + if not t.currentException.isNil: + mem.heap.heapDecRef(mem.allocator, t.currentException) - # Skip any further ``except`` pattern and find the first instruction of - # the handler body - while c.code[pc].opcode == opcExcept: - inc pc + t.currentException = ex - if matched: - break +proc decodeControl(x: BiggestInt): tuple[fromEh: bool, val: uint32] = + let x = cast[BiggestUInt](x) + result.fromEh = bool(x shr 63) + result.val = uint32(x) - # If no handler in this chain is able to catch this exception we check if - # the "parent" chains are able to. If this chain ends with a `finally` - # block we must execute it before continuing. - pc = pcEndExcept +proc runEh(t: var VmThread, c: var TCtx): Result[PrgCtr, VmException] = + ## Executes the active EH thread. Returns either the bytecode position to + ## resume main execution at, or the uncaught exception. + ## + ## This implements the VM-in-VM for executing the EH instructions. + template tos: untyped = + # top-of-stack + t.ehStack[^1] - # Where the handler body starts - let pcBody = pc + while true: + let instr = c.ehCode[tos.pc] + # already move to the next instruction + inc tos.pc - if matched: - return (ExceptionGotoHandler, pcBody) - elif c.code[pc].opcode == opcFinally: - # The +1 here is here because we don't want to execute it since we've - # already pop'd this statepoint from the stack. - return (ExceptionGotoFinally, pc + 1) + template yieldControl() = + setCurrentException(t, c.memory, tos.ex.refVal) + result.initSuccess(instr.b.PrgCtr) + return - return (ExceptionGotoUnhandled, 0) + case instr.opcode + of ehoExcept, ehoFinally: + # enter exception handler + yieldControl() + of ehoExceptWithFilter: + let + raised = c.heap.tryDeref(tos.ex.refVal, noneType).value() -proc resumeRaise(c: var TCtx, t: var VmThread): PrgCtr = - ## Resume raising the active exception and returns the program counter - ## (adjusted by -1) of the instruction to execute next. The stack is unwound - ## until either an exception handler matching the active exception's type or - ## a finalizer is found. - let - raised = c.heap.tryDeref(t.activeException, noneType).value() - excType = raised.typ + if getTypeRel(raised.typ, c.types[instr.a]) in {vtrSub, vtrSame}: + # success: the filter matches + yieldControl() + else: + discard "not handled, try the next instruction" + of ehoNext: + tos.pc += instr.b - 1 # account for the ``inc`` above + of ehoLeave: + case instr.a + of 0: + # discard the parent thread + swap(tos, t.ehStack[^2]) + t.ehStack.setLen(t.ehStack.len - 1) + of 1: + # discard the parent thread if it's associated with the provided + # ``finally`` + let instr = c.code[instr.b] + vmAssert instr.opcode == opcFinallyEnd + let (fromEh, b) = decodeControl(t.sframes[^1].slots[instr.regA].intVal) + if fromEh: + vmAssert b.int == t.ehStack.high - 1 + swap(tos, t.ehStack[^2]) + t.ehStack.setLen(t.ehStack.len - 1) + else: + vmUnreachable("illegal operand") + of ehoEnd: + # terminate the thread and return the unhandled exception + result.initFailure(move t.ehStack[^1].ex) + t.ehStack.setLen(t.ehStack.len - 1) + break + +proc opRaise(c: var TCtx, t: var VmThread, at: PrgCtr, + ex: sink VmException): Result[PrgCtr, VmException] = + ## Searches for an exception handler for the instruction at `at`. If one is + ## found, the stack is unwound till the frame the handler is in and the + ## position where to resume is returned. If there is none, `ex` is returned. var - frame = t.sframes.len - jumpTo = (why: ExceptionGotoUnhandled, where: 0) + pc = at + frame = t.sframes.high + + while frame >= 0: + let + handlers = t.sframes[frame].eh + offset = uint32(pc - t.sframes[frame].baseOffset) + + # search for the instruction's asscoiated exception handler: + for i in handlers.items: + if c.ehTable[i].offset == offset: + # found an associated EH instruction, spawn an EH thread and run it + t.ehStack.add (ex, c.ehTable[i].instr) + let r = runEh(t, c) + if r.isOk: + # entered a handler or finalizer. Unwind to the target frame + for j in (frame+1).. 0: + # the exception wasn't handled, try the above frame + pc = t.sframes[frame].comesFrom dec frame - jumpTo = findExceptionHandler(c, t.sframes[frame], excType) - - case jumpTo.why: - of ExceptionGotoHandler, ExceptionGotoFinally: - # unwind till the frame of the handler or finalizer - for i in (frame+1).. 0 and t.sframes[prevFrame].prc != nil: + let genSymOwner = if prevFrame > 0: t.sframes[prevFrame].prc else: c.module @@ -1954,7 +1955,7 @@ proc rawExecute(c: var TCtx, t: var VmThread, pc: var int): YieldReason = # logic as for loops: if newPc < pc: handleJmpBack() #echo "new pc ", newPc, " calling: ", prc.name.s - var newFrame = TStackFrame(prc: prc, comesFrom: pc, savedPC: -1) + var newFrame = TStackFrame(prc: prc, comesFrom: pc) newFrame.slots.newSeq(regCount) if instr.opcode == opcIndCallAsgn: checkHandle(regs[ra]) @@ -2045,37 +2046,61 @@ proc rawExecute(c: var TCtx, t: var VmThread, pc: var int): YieldReason = let instr2 = c.code[pc] let rbx = instr2.regBx - wordExcess - 1 # -1 for the following 'inc pc' inc pc, rbx - of opcTry: - let rbx = instr.regBx - wordExcess - t.sframes[tos].pushSafePoint(pc + rbx) - assert c.code[pc+rbx].opcode in {opcExcept, opcFinally} - of opcExcept: - # This opcode is never executed, it only holds information for the - # exception handling routines. - doAssert(false) + of opcEnter: + # enter the finalizer to the target but consider finalizers associated + # with the instruction + let target = pc + c.code[pc].regBx - wordExcess + if c.code[target].opcode == opcFinally: + # remember where to jump back when leaving the finally section + let reg = c.code[target].regA + regs[reg].cleanUpReg(c.memory) + regs[reg].initIntReg(pc + 1) + # jump to the instruction following the 'Finally' + pc = target + else: + vmUnreachable("target is not a 'Finally' instruction") + of opcLeave: + case (instr.regC - byteExcess) + of 0: # exit the EH thread + c.heap.heapDecRef(c.allocator, t.ehStack[^1].ex.refVal) + t.ehStack.setLen(t.ehStack.len - 1) + of 1: # exit the finally section + let (fromEh, b) = decodeControl(regs[ra].intVal) + if fromEh: + # only the topmost EH thread can be aborted + vmAssert t.ehStack.high == int(b) + c.heap.heapDecRef(c.allocator, t.ehStack[^1].ex.refVal) + t.ehStack.setLen(t.ehStack.len - 1) + + # the instruction is a no-op when leaving a finally section that wasn't + # entered through an exception + else: + vmUnreachable("invalid operand") + + setCurrentException(t, c.memory): + if t.ehStack.len > 0: + t.ehStack[^1].ex.refVal + else: + HeapSlotHandle(0) + of opcFinally: - # Pop the last safepoint introduced by a opcTry. This opcode is only - # executed _iff_ no exception was raised in the body of the `try` - # statement hence the need to pop the safepoint here. - doAssert(currFrame.savedPC < 0) - t.sframes[tos].popSafePoint() + # when entered by normal control-flow, the corresponding exit will jump + # to the target specified on this instruction + decodeBx(rkInt) + regs[ra].intVal = pc + rbx of opcFinallyEnd: - # The control flow may not resume at the next instruction since we may be - # raising an exception or performing a cleanup. - # XXX: the handling here is wrong in many scenarios, but it works okay - # enough until ``finally`` handling is reworked - if currFrame.savedPC >= 0: - # resume clean-up - pc = currFrame.savedPC - 1 - currFrame.savedPC = -1 - elif t.activeException.isNotNil: - # the finally was entered through a raise -> resume. A return can abort - # unwinding, thus an active exception is only considered when there's - # no cleanup action in progress - pc = resumeRaise(c, t) - updateRegsAlias() + # where control-flow resumes depends on how the finally section was + # entered + let (isError, target) = decodeControl(regs[ra].intVal) + if isError: + # continue the EH thread + pc = runEh(t, c).handle(c, t) - 1 + # FIXME: ^^ this is wrong. Unwinding needs to continue too! else: - discard "fall through" + # not entered through exceptional control-flow; jump to target stored + # in the register + pc = PrgCtr(target) - 1 + of opcRaise: decodeBImm() checkHandle(regs[ra]) @@ -2083,30 +2108,15 @@ proc rawExecute(c: var TCtx, t: var VmThread, pc: var int): YieldReason = # `imm == 0` -> raise; `imm == 1` -> reraise current exception let isReraise = imm == 1 - let raisedRef = - if isReraise: - # TODO: must raise a defect when there's no current exception - t.currentException - else: - assert regs[ra].handle.typ.kind == akRef - regs[ra].atomVal.refVal - - let raised = c.heap.tryDeref(raisedRef, noneType).value() - - # XXX: the exception is never freed right now - - # Keep the exception alive during exception handling - c.heap.heapIncRef(raisedRef) - if not t.currentException.isNil: - c.heap.heapDecRef(c.allocator, t.currentException) - - t.currentException = raisedRef - t.activeException = raisedRef - - # gather the stack-trace for the exception: - block: + var exception: VmException + if isReraise: + # re-raise the current exception + exception = move t.ehStack[^1].ex + # popping the thread is the responsibility of the spawned EH thread + else: + # gather the stack-trace for the exception: var pc = pc - t.activeExceptionTrace.setLen(t.sframes.len) + exception.trace.newSeq(t.sframes.len) for i, it in t.sframes.pairs: let p = @@ -2115,8 +2125,13 @@ proc rawExecute(c: var TCtx, t: var VmThread, pc: var int): YieldReason = else: pc - t.activeExceptionTrace[i] = (it.prc, p) + exception.trace[i] = (it.prc, p) + + exception.refVal = regs[ra].atomVal.refVal + # keep the exception alive during exception handling: + c.heap.heapIncRef(exception.refVal) + let raised = c.heap.tryDeref(exception.refVal, noneType).value() let name = deref(raised.getFieldHandle(1.fpos)) if not isReraise and name.strVal.len == 0: # XXX: the VM doesn't distinguish between a `nil` cstring and an empty @@ -2127,7 +2142,7 @@ proc rawExecute(c: var TCtx, t: var VmThread, pc: var int): YieldReason = # raise name.strVal.asgnVmString(regs[rb].strVal, c.allocator) - pc = resumeRaise(c, t) + pc = opRaise(c, t, pc, exception).handle(c, t) - 1 updateRegsAlias() of opcNew: let typ = c.types[instr.regBx - wordExcess] @@ -2925,7 +2940,6 @@ proc `=copy`*(x: var VmThread, y: VmThread) {.error.} proc initVmThread*(c: var TCtx, pc: int, frame: sink TStackFrame): VmThread = ## Sets up a ``VmThread`` instance that will start execution at `pc`. ## `frame` provides the initial stack frame. - frame.savedPC = -1 # initialize the field here VmThread(pc: pc, loopIterations: c.config.maxLoopIterationsVM, sframes: @[frame]) diff --git a/compiler/vm/vm_enums.nim b/compiler/vm/vm_enums.nim index 704157a4f9f..ca0dcb32d78 100644 --- a/compiler/vm/vm_enums.nim +++ b/compiler/vm/vm_enums.nim @@ -20,6 +20,8 @@ type opcYldYoid, # yield with no value opcYldVal, # yield with a value + opcSetEh # sets the active instruction-to-EH mappings list + opcAsgnInt, opcAsgnFloat, opcAsgnComplex, @@ -136,8 +138,9 @@ type opcJmp, # jump Bx opcJmpBack, # jump Bx; resulting from a while loop opcBranch, # branch for 'case' - opcTry, - opcExcept, + opcEnter, # jump Bx; target must be a ``opcFinally`` instruction + opcLeave, # if C == 1: abort EH thread associated with finally; + # if C == 0; abort active EH thread opcFinally, opcFinallyEnd, opcNew, @@ -169,4 +172,4 @@ const firstABxInstr* = opcTJmp largeInstrs* = { # instructions which use 2 int32s instead of 1: opcConv, opcObjConv, opcCast, opcNewSeq, opcOf} - relativeJumps* = {opcTJmp, opcFJmp, opcJmp, opcJmpBack} + relativeJumps* = {opcTJmp, opcFJmp, opcJmp, opcJmpBack, opcEnter, opcFinally} diff --git a/compiler/vm/vmbackend.nim b/compiler/vm/vmbackend.nim index 9e1c17f6afc..aa11f35dfbd 100644 --- a/compiler/vm/vmbackend.nim +++ b/compiler/vm/vmbackend.nim @@ -294,6 +294,8 @@ proc generateCode*(g: ModuleGraph, mlist: sink ModuleList) = env.config = c.gen.config # currently needed by the packer env.code = move c.gen.code env.debug = move c.gen.debug + env.ehTable = move c.gen.ehTable + env.ehCode = move c.gen.ehCode env.functions = move base(c.functions) env.constants = move c.gen.constants env.rtti = move c.gen.rtti diff --git a/compiler/vm/vmdef.nim b/compiler/vm/vmdef.nim index 30f72401e6e..7bb32c41c66 100644 --- a/compiler/vm/vmdef.nim +++ b/compiler/vm/vmdef.nim @@ -28,6 +28,7 @@ import ], compiler/utils/[ debugutils, + idioms ] import std/options as std_options @@ -660,10 +661,41 @@ type VmRawStackTrace* = seq[tuple[sym: PSym, pc: PrgCtr]] + HandlerTableEntry* = tuple + offset: uint32 ## instruction offset + instr: uint32 ## position of the EH instruction to spawn a thread with + + EhOpcode* = enum + ehoExcept + ## unconditional exception handler + ehoExceptWithFilter + ## conditionl exception handler. If the exception is a subtype or equal + ## to the specified type, the handler is entered + ehoFinally + ## enter the ``finally`` handler + ehoNext + ## relative jump to another instruction + ehoLeave + ## abort the parent thread + ehoEnd + ## ends the thread without treating the exception as handled + + EhInstr* = tuple + ## Exception handling instruction. 8-byte in size. + opcode: EhOpcode + a: uint16 ## meaning depends on the opcode + b: uint32 ## meaning depends on the opcode + TCtx* = object code*: seq[TInstr] debug*: seq[TLineInfo] # line info for every instruction; kept separate # to not slow down interpretation + ehTable*: seq[HandlerTableEntry] + ## stores the instruction-to-EH mappings. Used to look up the EH + ## instruction to start exception handling with in case of a normal + ## instruction raising + ehCode*: seq[EhInstr] + ## stores the instructions for the exception handling (EH) mechanism globals*: seq[HeapSlotHandle] ## Stores each global's corresponding heap slot constants*: seq[VmConstant] ## constant data complexConsts*: seq[LocHandle] ## complex constants (i.e. everything that @@ -707,15 +739,13 @@ type prc*: PSym # current prc; proc that is evaluated slots*: seq[TFullReg] # parameters passed to the proc + locals; # parameters come first + eh*: HOslice[int] + ## points to the active list of instruction-to-EH mappings + baseOffset*: PrgCtr + ## the instruction that all offsets in the instruction-to-EH list are + ## relative to. Only valid when `eh` is not empty comesFrom*: int - safePoints*: seq[int] # used for exception handling - # XXX 'break' should perform cleanup actions - # What does the C backend do for it? - - savedPC*: PrgCtr ## remembers the program counter of the ``Ret`` - ## instruction during cleanup. -1 indicates that - ## no clean-up is happening ProfileInfo* = object ## Profiler data for a single procedure. diff --git a/compiler/vm/vmerrors.nim b/compiler/vm/vmerrors.nim index 8d585ee2884..a843d7260fd 100644 --- a/compiler/vm/vmerrors.nim +++ b/compiler/vm/vmerrors.nim @@ -28,9 +28,24 @@ func raiseVmError*( event.instLoc = inst raise (ref VmError)(event: event) +func vmUnreachable(msg: sink string, inst: InstantiationInfo + ) {.noinline, noreturn.} = + ## Raises an internal VM error with `msg` as the message. + raiseVmError(VmEvent(kind: vmEvtErrInternal, msg: msg), inst) + # templates below are required as InstantiationInfo isn't captured otherwise template raiseVmError*(event: VmEvent) = ## Raises a `VmError`, using the source code position of the callsite as the ## `inst` value. - raiseVmError(event, instLoc(-2)) \ No newline at end of file + raiseVmError(event, instLoc(-2)) + +template vmUnreachable*(msg: sink string) = + ## Raises an internal VM error with `msg` as the message. + vmUnreachable(msg, instLoc(-2)) + +template vmAssert*(cond: bool) = + ## Raises an ``AssertionDefect`` or VM error depending on the compile- + ## time configuration. + # XXX: implement this properly + assert cond \ No newline at end of file diff --git a/compiler/vm/vmgen.nim b/compiler/vm/vmgen.nim index fe6e67865b1..48714d556b0 100644 --- a/compiler/vm/vmgen.nim +++ b/compiler/vm/vmgen.nim @@ -129,8 +129,15 @@ type isIndirect: bool ## whether the local uses a handle while its value ## would fit it into a register + BlockKind = enum + bkBlock ## labeled block + bkTry ## the ``try`` and ``except`` clause of a ``finally``-having + ## try statement + bkExcept ## ``except`` clause + bkFinally ## ``finally`` clause + BProc = object - blocks: seq[seq[TPosition]] + blocks: seq[tuple[kind: BlockKind, exits: seq[TPosition], cr: TRegister]] ## for each block, the jump instructions targeting the block's exit. ## These need to be patched once the code for the block is generated sym: PSym @@ -144,6 +151,17 @@ type locals: OrdinalSeq[LocalId, LocalLoc] ## current state of all locals + # exception handling state: + baseOffset: TPosition + ## the bytecode position that instruction-to-EH mappings need to be + ## relative to + hasEh: int + ## > 0 when some form of exception handling exists for the current + ## node + raiseExits: int + ## used to establish a relation between two points during code + ## generation (e.g., "are there new exceptional exits since X?") + CodeGenCtx* = object ## Bundles all input, output, and other contextual data needed for the ## code generator @@ -161,6 +179,8 @@ type # input-output parameters: code*: seq[TInstr] debug*: seq[TLineInfo] + ehTable*: seq[HandlerTableEntry] + ehCode*: seq[EhInstr] constants*: seq[VmConstant] typeInfoCache*: TypeInfoCache rtti*: seq[VmTypeInfo] @@ -399,6 +419,31 @@ proc patch(c: var TCtx, p: TPosition) = c.code[p] = ((oldInstr.TInstrType and regBxMask).TInstrType or TInstrType(diff+wordExcess) shl regBxShift).TInstr +proc genSetEh(c: var TCtx, info: TLineInfo): TPosition = + # the correct values are set at a later point + result = c.code.len.TPosition + c.prc.baseOffset = result + c.gABC(info, opcSetEh, c.ehTable.len, 0) + +proc patchSetEh(c: var TCtx, p: TPosition) = + ## Patches the ``SetEh`` instruction at `p` with the mapping list's upper + ## bound (using the current end of the mapping list). + let + p = p.int + fin = c.ehTable.len + assert c.code[p].opcode == opcSetEh + c.code[p] = TInstr((c.code[p].TInstrType and regAMask) or + TInstrType(fin shl regBShift)) + +proc registerEh(c: var TCtx) = + ## If a jump-list designated for exception handling is active, associates it + ## with the next-emitted instruction. + if c.prc.hasEh > 0: + inc c.prc.raiseExits + let pos = c.code.len + c.ehTable.add: + (uint32(pos - c.prc.baseOffset.int), c.ehCode.len.uint32) + proc getSlotKind(t: PType): TSlotKind = case t.skipTypes(IrrelevantTypes+{tyRange}).kind of tyBool, tyChar, tyInt..tyInt64, tyUInt..tyUInt64: @@ -632,13 +677,19 @@ proc genRepeat(c: var TCtx; n: CgNode) = c.gen(n[0]) c.jmpBack(n, lab1) +func initBlock(kind: BlockKind, cr = TRegister(0)): typeof(BProc().blocks[0]) = + ## NOTE: this procedure is a workaround for a bug of the current csources + ## compiler. `isTry` being a literal bool value would lead to run-time + ## crashes. + result = (kind, @[], cr) + proc genBlock(c: var TCtx; n: CgNode) = let oldRegisterCount = c.prc.regInfo.len - c.prc.blocks.add @[] # push a new block + c.prc.blocks.add initBlock(bkBlock) # push a new block c.gen(n[1]) # fixup the jumps: - for pos in c.prc.blocks[^1].items: + for pos in c.prc.blocks[^1].exits.items: c.patch(pos) # pop the block again: c.prc.blocks.setLen(c.prc.blocks.len - 1) @@ -654,9 +705,36 @@ proc genBlock(c: var TCtx; n: CgNode) = doAssert false, "leaking temporary " & $i & " " & $c.prc.regInfo[i].kind c.prc.regInfo[i] = RegInfo(kind: slotEmpty) +proc blockLeaveActions(c: var TCtx, info: CgNode, target: Natural) = + ## Emits the bytecode for leaving a block. `target` is the index of the + ## block to exit. + # perform the leave actions from innermost to outermost + for i in countdown(c.prc.blocks.high, target): + case c.prc.blocks[i].kind + of bkBlock: + discard "no leave action to perfrom" + of bkTry: + # enter the finally clause + c.prc.blocks[i].exits.add c.xjmp(info, opcEnter) + of bkExcept: + # leave the except clause + c.gABI(info, opcLeave, 0, 0, 0) + of bkFinally: + # leave the finally clause + c.gABI(info, opcLeave, c.prc.blocks[i].cr, 0, 1) + proc genBreak(c: var TCtx; n: CgNode) = - let lab1 = c.xjmp(n, opcJmp) - c.prc.blocks[n[0].label.int].add lab1 + # find the labeled block corresponding to the block ID: + var i, b = 0 + while b < n[0].label.int or c.prc.blocks[i].kind != bkBlock: + b += ord(c.prc.blocks[i].kind == bkBlock) + inc i + + blockLeaveActions(c, n, i) + + # emit the actual jump to the end of targeted labeled block: + let label = c.xjmp(n, opcJmp) + c.prc.blocks[i].exits.add label proc genIf(c: var TCtx, n: CgNode) = # if (!expr1) goto lab1; @@ -897,39 +975,169 @@ proc genTypeInfo(c: var TCtx, typ: PType): int = internalAssert(c.config, result <= regBxMax, "") -proc genTry(c: var TCtx; n: CgNode) = - var endings: seq[TPosition] = @[] - let ehPos = c.xjmp(n, opcTry, 0) - c.gen(n[0]) - # Add a jump past the exception handling code - let jumpToFinally = c.xjmp(n, opcJmp, 0) - # This signals where the body ends and where the exception handling begins - c.patch(ehPos) - for i in 1.. 1: + # exception handler with filter for j in 0.. firstExit: + # all exceptional exits from within the ``except`` need to close the + # thread that entered it + c.ehCode.add (ehoNext, 0'u16, 2'u32) + c.ehCode.add (ehoLeave, 0'u16, 0'u32) + c.prc.raiseExits = firstExit + hasRaiseExits = true + + if i < last: + # emit a jump past the following handlers + exits.add c.xjmp(n[i], opcJmp) + + for endPos in exits.items: + c.patch(endPos) + + if n[last].len > 1 or hasRaiseExits: + # exceptional control-flow possibly leaves the handler section (because + # there's no catch-all handler), OR one of the handlers potentially + # raises + inc c.prc.raiseExits + +proc genFinally(c: var TCtx, n: CgNode, firstExit: int) = + ## Generates and emits the code for a ``cnkFinally`` clause. + let + enteredViaExcept = c.prc.raiseExits > firstExit + startEh = c.ehCode.len + + # patch the 'Enter' instructions entering the finalizer and then pop the + # block + for pos in c.prc.blocks[^1].exits.items: + c.patch(pos) + c.prc.blocks.setLen(c.prc.blocks.len - 1) + + # omit the EH 'Finally' instruction if there are no exceptional exits + if enteredViaExcept: + c.ehCode.add (ehoFinally, 0'u16, uint32 c.genLabel()) + # add a tentative 'Next' instruction; it's removed again if not needed + c.ehCode.add (ehoNext, 0'u16, 0'u32) + # all exceptional threads are handled + c.prc.raiseExits = firstExit + + let + control = c.getTemp(slotTempInt) + start = c.xjmp(n, opcFinally, control) + + # generate the code for the body + c.prc.blocks.add initBlock(bkFinally, control) + c.prc.hasEh += ord(enteredViaExcept) + c.gen(n[0]) + c.prc.hasEh -= ord(enteredViaExcept) + c.prc.blocks.setLen(c.prc.blocks.len - 1) + + if enteredViaExcept: + if c.prc.raiseExits > firstExit: + # the 'finally' could be part of an active exceptional thread, and + # the 'finally' clause has an exceptional exit. Patch the earlier + # 'Next' instruction to point *past* the 'Leave' + c.ehCode[startEh + 1].b = uint32(c.ehCode.len - (startEh+1) + 1) + c.ehCode.add (ehoLeave, 1'u16, uint32 c.genLabel()) + else: + # remove the unneeded 'Next' + c.ehCode.setLen(startEh + 1) + + # continue the exceptional control-flow + inc c.prc.raiseExits + + c.gABx(n, opcFinallyEnd, control, 0) + c.patch(start) + c.freeTemp(control) + +proc genTry(c: var TCtx; n: CgNode) = + let + hasExcept = n[1].kind == cnkExcept + hasFinally = n[^1].kind == cnkFinally + startEh = c.ehCode.len + firstExit = c.prc.raiseExits + needsSkip = firstExit > 0 and c.ehCode[^1].opcode != ehoNext + + if needsSkip: + # an unclosed EH chain on the same level exists, e.g.: + # try: + # try: ... finally: ... # <- this is the unclosed chain + # try: ... finally: ... + # except: ... + # + # make sure the new chain doesn't enter the finally/except clauses emitted + # for the current 'try' + c.ehCode.add (ehoNext, 0'u16, 0'u32) + + if hasFinally: + c.prc.blocks.add initBlock(bkTry) + + # emit the bytecode for the 'try' body: + inc c.prc.hasEh + c.gen(n[0]) + dec c.prc.hasEh + + # omit the exception handlers if there are no exceptional exits from within + # the try clause + if hasExcept and c.prc.raiseExits > firstExit: + let eh = c.xjmp(n, opcJmp) # jump past the exception handling + c.prc.hasEh += ord(hasFinally) + genExcept(c, n, firstExit) + c.prc.hasEh -= ord(hasFinally) + c.patch(eh) + + if hasFinally: + genFinally(c, n[^1], firstExit) + + if needsSkip: + # patch the 'Next' instruction skipping the handler chain + c.ehCode[startEh].b = uint32(c.ehCode.len - startEh) + + if c.prc.hasEh == 0: + # end the EH chain if there are no more applicable handlers within the + # current procedure + assert firstExit == 0 + c.ehCode.add (ehoEnd, 0'u16, 0'u32) + c.prc.raiseExits = firstExit + # echo "emit: end" proc genRaise(c: var TCtx; n: CgNode) = if n[0].kind != cnkEmpty: @@ -941,12 +1149,14 @@ proc genRaise(c: var TCtx; n: CgNode) = var name: TDest = c.getTemp(c.graph.getSysType(n.info, tyString)) c.genLit(n[0], c.toStringCnst(typ.sym.name.s), name) + c.registerEh() # XXX: using an ABxI encoding would make sense here... c.gABI(n, opcRaise, dest, name, 0) c.freeTemp(name) c.freeTemp(dest) else: # reraise + c.registerEh() c.gABI(n, opcRaise, 0, 0, imm=1) proc writeBackResult(c: var TCtx, info: CgNode) = @@ -966,10 +1176,10 @@ proc writeBackResult(c: var TCtx, info: CgNode) = c.freeTemp(tmp) proc genReturn(c: var TCtx; n: CgNode) = + blockLeaveActions(c, n, 0) writeBackResult(c, n) c.gABC(n, opcRet) - proc genLit(c: var TCtx; n: CgNode; lit: int; dest: var TDest) = ## `lit` is the index of a constant as returned by `genLiteral` @@ -1053,6 +1263,8 @@ proc genCall(c: var TCtx; n: CgNode; dest: var TDest) = if i >= fntyp.len: internalAssert(c.config, tfVarargs in fntyp.flags) c.gABx(n, opcSetType, r, c.genType(n[i].typ)) + + c.registerEh() if dest.isUnset: c.gABC(n, opcIndCall, 0, x, n.len) else: @@ -3151,7 +3363,9 @@ proc genStmt*(c: var TCtx; body: sink Body): Result[int, VmGenDiag] = var d: TDest = -1 try: + let eh = genSetEh(c, n.info) c.gen(n, d) + c.patchSetEh(eh) except VmGenError as e: return typeof(result).err(move e.diag) @@ -3165,7 +3379,9 @@ proc genExpr*(c: var TCtx; body: sink Body): Result[int, VmGenDiag] = var d: TDest = -1 try: + let eh = genSetEh(c, n.info) c.gen(n, d) + c.patchSetEh(eh) except VmGenError as e: return typeof(result).err(move e.diag) @@ -3332,9 +3548,11 @@ proc genProcBody(c: var TCtx): int = c.gABC(body, opcObjConv, env, env) c.gABx(body, opcObjConv, 0, c.genType(c.prc.body[LocalId env].typ)) + let eh = genSetEh(c, body.info) gen(c, body) + c.patchSetEh(eh) - # generate final 'return' statement: + # generate the final 'return' statement: writeBackResult(c, body) c.gABC(body, opcRet) diff --git a/compiler/vm/vmjit.nim b/compiler/vm/vmjit.nim index 898aa22760c..6aab442ac13 100644 --- a/compiler/vm/vmjit.nim +++ b/compiler/vm/vmjit.nim @@ -90,6 +90,8 @@ func swapState(c: var TCtx, gen: var CodeGenCtx) = # input-output parameters: swap(code) swap(debug) + swap(ehTable) + swap(ehCode) swap(constants) swap(typeInfoCache) swap(rtti) diff --git a/compiler/vm/vmrunner.nim b/compiler/vm/vmrunner.nim index 4aa9d6d3612..006b1601b77 100644 --- a/compiler/vm/vmrunner.nim +++ b/compiler/vm/vmrunner.nim @@ -183,6 +183,8 @@ proc loadFromFile(c: var TCtx, overrides: var seq[string], loadIntoContext(c, p) c.code = move p.code + c.ehTable = move p.ehTable + c.ehCode = move p.ehCode overrides = move p.callbacks result.initSuccess(p.entryPoint) diff --git a/compiler/vm/vmutils.nim b/compiler/vm/vmutils.nim index 5d0ac2ed875..8e40c9266ae 100644 --- a/compiler/vm/vmutils.nim +++ b/compiler/vm/vmutils.nim @@ -136,12 +136,12 @@ proc renderCodeListing*(config: ConfigRef, sym: PSym, $ Date: Fri, 2 Feb 2024 16:24:18 +0000 Subject: [PATCH 02/11] vm: fix illegal ref-counter increment `vm.setCurrentException` always incremented the provided refs ref- counter, even if the ref was nil (which is a valid case). An `isNotNil` guard is added to prevent the ref-counter being incremented. --- compiler/vm/vm.nim | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/compiler/vm/vm.nim b/compiler/vm/vm.nim index 49454d98e4c..0629ec0ebcf 100644 --- a/compiler/vm/vm.nim +++ b/compiler/vm/vm.nim @@ -490,8 +490,9 @@ proc setCurrentException(t: var VmThread, mem: var VmMemoryManager, ex: HeapSlotHandle) = ## Sets `ex` as `t`'s current exception, freeing the previous exception, ## if necessary. - mem.heap.heapIncRef(ex) - if not t.currentException.isNil: + if ex.isNotNil: + mem.heap.heapIncRef(ex) + if t.currentException.isNotNil: mem.heap.heapDecRef(mem.allocator, t.currentException) t.currentException = ex From c817ca0cafd4e293e1bbd57cbeb87fd8194b420b Mon Sep 17 00:00:00 2001 From: zerbina <100542850+zerbina@users.noreply.github.com> Date: Fri, 2 Feb 2024 16:24:18 +0000 Subject: [PATCH 03/11] vm: resume unwinding on `FinallyEnd` PR-local bug: exiting a finally section via `FinallyEnd` didn't continue stack frame unwinding, which would result in execution being aborted, even though there were exception handlers present. `opRaise` is split up into two procedures: `findEh` (find the EH code associated with an instruction) and `resumeEh` (execute the EH thread and unwind). This is so that `FinallyEnd` can use `resumeEh` to unwind correctly. --- compiler/vm/vm.nim | 105 ++++++++++++++++++++++++++++++--------------- 1 file changed, 70 insertions(+), 35 deletions(-) diff --git a/compiler/vm/vm.nim b/compiler/vm/vm.nim index 0629ec0ebcf..36a92399058 100644 --- a/compiler/vm/vm.nim +++ b/compiler/vm/vm.nim @@ -486,6 +486,34 @@ proc regToNode*(c: TCtx, x: TFullReg; typ: PType, info: TLineInfo): PNode = # ---- exception handling ---- +proc findEh(c: TCtx, t: VmThread, at: PrgCtr, frame: int + ): Option[tuple[frame: int, ehInstr: uint32]] = + ## Searches for the EH instruction that is associated with `at`. If none is + ## found on the current stack frame, the caller's call instruction is + ## inspected, then the caller of the caller, etc. + ## + ## On success, the EH instruction position and the stack frame the handler + ## is attached to are returned. + var + pc = at + frame = frame + + while frame >= 0: + let + handlers = t.sframes[frame].eh + offset = uint32(pc - t.sframes[frame].baseOffset) + + # search for the instruction's asscoiated exception handler: + for i in handlers.items: + if c.ehTable[i].offset == offset: + return some (frame, c.ehTable[i].instr) + + # no handler was found, try the above frame + pc = t.sframes[frame].comesFrom + dec frame + + # no handler exists + proc setCurrentException(t: var VmThread, mem: var VmMemoryManager, ex: HeapSlotHandle) = ## Sets `ex` as `t`'s current exception, freeing the previous exception, @@ -561,43 +589,50 @@ proc runEh(t: var VmThread, c: var TCtx): Result[PrgCtr, VmException] = t.ehStack.setLen(t.ehStack.len - 1) break +proc resumeEh(c: var TCtx, t: var VmThread, + frame: int): Result[PrgCtr, VmException] = + ## Continues raising the exception from the top-most EH thread. If exception + ## handling code is found, unwinds the stack till where the handler is + ## located and returns the program counter where to resume. Otherwise + ## returns the unhandled exception. + var frame = frame + while true: + let r = runEh(t, c) + if r.isOk: + # an exception handler or finalizer is entered. Unwind to the target + # frame: + for j in (frame+1).. the exception is unhandled + return r + else: + # exception was not handled on the current frame, try the frame above + let pos = findEh(c, t, t.sframes[frame].comesFrom, frame) + if pos.isSome: + # EH code exists in a frame above. Run it + frame = pos.get().frame # update to the frame the EH code is part of + t.ehStack.add (r.takeErr(), pos.get().ehInstr) + else: + return r + proc opRaise(c: var TCtx, t: var VmThread, at: PrgCtr, ex: sink VmException): Result[PrgCtr, VmException] = ## Searches for an exception handler for the instruction at `at`. If one is ## found, the stack is unwound till the frame the handler is in and the - ## position where to resume is returned. If there is none, `ex` is returned. - var - pc = at - frame = t.sframes.high - - while frame >= 0: - let - handlers = t.sframes[frame].eh - offset = uint32(pc - t.sframes[frame].baseOffset) - - # search for the instruction's asscoiated exception handler: - for i in handlers.items: - if c.ehTable[i].offset == offset: - # found an associated EH instruction, spawn an EH thread and run it - t.ehStack.add (ex, c.ehTable[i].instr) - let r = runEh(t, c) - if r.isOk: - # entered a handler or finalizer. Unwind to the target frame - for j in (frame+1).. Date: Fri, 2 Feb 2024 16:24:18 +0000 Subject: [PATCH 04/11] tests: remove `knownIssue` marker from some tests The tests succeed with the VM now. --- tests/exception/texceptions.nim | 3 --- tests/exception/tfinally.nim | 3 --- tests/exception/tfinally2.nim | 3 --- tests/exception/tfinally3.nim | 3 --- 4 files changed, 12 deletions(-) diff --git a/tests/exception/texceptions.nim b/tests/exception/texceptions.nim index 573dfccbe1e..c0a84b3a6cc 100644 --- a/tests/exception/texceptions.nim +++ b/tests/exception/texceptions.nim @@ -13,9 +13,6 @@ BEFORE EXCEPT: IOError: hi FINALLY ''' - knownIssue.vm: ''' - Exception/finally handling is largely disfunctional in the VM - ''' """ echo "" diff --git a/tests/exception/tfinally.nim b/tests/exception/tfinally.nim index 2bb68b6a532..0269c806142 100644 --- a/tests/exception/tfinally.nim +++ b/tests/exception/tfinally.nim @@ -13,9 +13,6 @@ finally1 except2 finally2 ''' - knownIssue.vm: ''' - Exception/finally handling is largely disfunctional in the VM - ''' """ # Test return in try statement: diff --git a/tests/exception/tfinally2.nim b/tests/exception/tfinally2.nim index dace6fb2f45..84d2aeb3dc5 100644 --- a/tests/exception/tfinally2.nim +++ b/tests/exception/tfinally2.nim @@ -5,9 +5,6 @@ B C D ''' - knownIssue.vm: ''' - Exception/finally handling is largely disfunctional in the VM - ''' """ # Test break in try statement: diff --git a/tests/exception/tfinally3.nim b/tests/exception/tfinally3.nim index 00a80f9fad9..d58630e568e 100644 --- a/tests/exception/tfinally3.nim +++ b/tests/exception/tfinally3.nim @@ -4,9 +4,6 @@ false Within finally->try ''' exitCode: 1 - knownIssue.vm: ''' - Exception/finally handling is largely disfunctional in the VM - ''' """ # Test break in try statement: From 812bb0955e8724e1545b9d43337f187fa07d7588 Mon Sep 17 00:00:00 2001 From: zerbina <100542850+zerbina@users.noreply.github.com> Date: Fri, 2 Feb 2024 16:24:19 +0000 Subject: [PATCH 05/11] vmgen: fix wrong `SetEh` patching The `SetEh` instruction patching was implemented incorrectly, resulting in incorrect operand value when the lower bound is >= 256. --- compiler/vm/vmgen.nim | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/compiler/vm/vmgen.nim b/compiler/vm/vmgen.nim index bd3617442e2..891da3ebb99 100644 --- a/compiler/vm/vmgen.nim +++ b/compiler/vm/vmgen.nim @@ -433,9 +433,10 @@ proc patchSetEh(c: var TCtx, p: TPosition) = let p = p.int fin = c.ehTable.len - assert c.code[p].opcode == opcSetEh - c.code[p] = TInstr((c.code[p].TInstrType and regAMask) or - TInstrType(fin shl regBShift)) + instr = c.code[p] + assert instr.opcode == opcSetEh + # opcode and regA stay the same, only regB is updated: + c.code[p] = TInstr(instr.TInstrType or TInstrType(fin shl regBShift)) proc registerEh(c: var TCtx) = ## If a jump-list designated for exception handling is active, associates it From d33acc5283d79d5d1b2bb1660c35da33b8e00c99 Mon Sep 17 00:00:00 2001 From: zerbina <100542850+zerbina@users.noreply.github.com> Date: Sun, 4 Feb 2024 18:13:54 +0000 Subject: [PATCH 06/11] tests: add tests for the fixed issues --- tests/exception/tfinally6.nim | 172 ++++++++++++++++++ tests/exception/tleave_except.nim | 30 +++ .../exception/traise_and_handle_in_except.nim | 31 ++++ tests/exception/twrong_handler.nim | 26 +++ 4 files changed, 259 insertions(+) create mode 100644 tests/exception/tfinally6.nim create mode 100644 tests/exception/tleave_except.nim create mode 100644 tests/exception/traise_and_handle_in_except.nim create mode 100644 tests/exception/twrong_handler.nim diff --git a/tests/exception/tfinally6.nim b/tests/exception/tfinally6.nim new file mode 100644 index 00000000000..9bb9b5d14ae --- /dev/null +++ b/tests/exception/tfinally6.nim @@ -0,0 +1,172 @@ +discard """ + description: ''' + Multiple tests regarding ``finally`` interaction with exception handlers + and raised exceptions. + ''' + knownIssue.c js: "The current exception is not properly cleared" +""" + +var steps: seq[int] + +template test(call: untyped, expect: untyped) = + steps = @[] # reset the step list + {.line.}: + call + doAssert steps == expect, $steps + doAssert getCurrentException().isNil, "current exception wasn't cleared" + +# ------ the tests follow ------ + +proc simpleFinally() = + try: + try: + raise ValueError.newException("a") + finally: + steps.add 1 + steps.add 2 + except ValueError as e: + steps.add 3 + doAssert e.msg == "a" + +test simpleFinally(), [1, 3] + +proc raiseFromFinally() = + try: + try: + raise ValueError.newException("a") + finally: + steps.add 1 + raise ValueError.newException("b") + doAssert false, "unreachable" + except ValueError as e: + # the exception raised in the finally clause overrides the one raised + # earlier + steps.add 2 + doAssert e.msg == "b" + doAssert getCurrentException() == e + + steps.add 3 + +test raiseFromFinally(), [1, 2, 3] + +proc reraiseFromFinally() = + try: + try: + raise ValueError.newException("a") + finally: + steps.add 1 + # abort the exception but immediately re-raise it + raise + doAssert false, "unreachable" + except ValueError as e: + steps.add 2 + doAssert e.msg == "a" + doAssert getCurrentException() == e + + steps.add 3 + +test reraiseFromFinally(), [1, 2, 3] + +proc exceptionInFinally() = + ## Raise, and fully handle, an exception within a finally clause that was + ## entered through exceptionl control-flow. + try: + try: + raise ValueError.newException("a") + finally: + steps.add 1 + try: + raise ValueError.newException("b") + except ValueError as e: + steps.add 2 + doAssert e.msg == "b" + doAssert getCurrentException() == e + + steps.add 3 + # the current exception must be the one with which the finally section + # was entered + doAssert getCurrentException().msg == "a" + + doAssert false, "unreachable" + except ValueError as e: + steps.add 4 + doAssert e.msg == "a" + + steps.add 5 + +test exceptionInFinally(), [1, 2, 3, 4, 5] + +proc leaveFinally1() = + ## Ensure that exiting a finally clause entered through exceptional control- + ## flow via unstructured control-flow (break) works and properly clears the + ## current exception. + block exit: + try: + raise ValueError.newException("a") + finally: + steps.add 1 + doAssert getCurrentException().msg == "a" + break exit + doAssert false, "unreachable" + + steps.add 2 + +test leaveFinally1(), [1, 2] + +proc leaveFinally2() = + ## Ensure that aborting an exception raised within a finally clause entered + ## through exceptional control-flow doesn't interfere with the original + ## exception. + try: + try: + raise ValueError.newException("a") + finally: + block exit: + steps.add 1 + try: + raise ValueError.newException("b") + finally: + steps.add 2 + # discards the in-flight exception 'b' + break exit + doAssert false, "unreachable" + + steps.add 3 + # the current exception must be the one the finally was entered with: + doAssert getCurrentException().msg == "a" + # unwinding continues as usual + doAssert false, "unreachable" + except ValueError as e: + steps.add 4 + doAssert e.msg == "a" + doAssert getCurrentException() == e + +test leaveFinally2(), [1, 2, 3, 4] + +proc leaveFinally3(doExit: bool) = + ## Ensure that aborting an exception in a finally clause still visits all + ## enclosing finally clauses, and that the finally clauses observe the + ## correct current exception. + block exit: + try: + try: + raise ValueError.newException("a") + finally: + steps.add 1 + try: + if doExit: # obfuscate the break + break exit + finally: + steps.add 2 + # the current exception must still be set + doAssert getCurrentException().msg == "a" + doAssert false, "unreachable" + doAssert false, "unreachable" + finally: + steps.add 5 + # the finally section is not part of the inner try statement, so the + # current exception is nil + doAssert getCurrentException() == nil + doAssert false, "unreachable" + +test leaveFinally3(true), [1, 2, 5] diff --git a/tests/exception/tleave_except.nim b/tests/exception/tleave_except.nim new file mode 100644 index 00000000000..a49091a08e3 --- /dev/null +++ b/tests/exception/tleave_except.nim @@ -0,0 +1,30 @@ +discard """ + description: ''' + Ensure that exiting an exception handler via unstructured control-flow + (``break``) works and properly clears the current exception. + ''' + output: "done" + knownIssue.js: "The current exception is not properly cleared" +""" + +var steps: seq[int] + +block exit: + try: + raise ValueError.newException("a") + except ValueError as e: + steps.add 1 + if e.msg == "a": + # an unstructured exit of the except block needs to pop the current + # exception + break exit + else: + doAssert false, "unreachable" + doAssert false, "unreachable" + +steps.add 2 + +doAssert getCurrentException() == nil, "current exception was cleared" +doAssert steps == [1, 2] + +echo "done" # ensures that the assertion weren't jumped over diff --git a/tests/exception/traise_and_handle_in_except.nim b/tests/exception/traise_and_handle_in_except.nim new file mode 100644 index 00000000000..15078d14257 --- /dev/null +++ b/tests/exception/traise_and_handle_in_except.nim @@ -0,0 +1,31 @@ +discard """ + description: ''' + Ensure that raising and fully handling an exception within an ``except`` + branch works. + ''' + output: "done" + knownIssue.js: "The current exception is not properly cleared" +""" + +var steps: seq[int] + +try: + raise ValueError.newException("a") +except ValueError as e: + steps.add 1 + try: + raise ValueError.newException("b") + except ValueError as e: + steps.add 2 + doAssert e.msg == "b" + doAssert getCurrentException() == e + + steps.add 3 + # make sure the current exception is still the correct one + doAssert getCurrentException() == e + +steps.add 4 +doAssert getCurrentException() == nil, "current exception wasn't cleared" +doAssert steps == [1, 2, 3, 4] + +echo "done" # make sure the assertions weren't skipped over diff --git a/tests/exception/twrong_handler.nim b/tests/exception/twrong_handler.nim new file mode 100644 index 00000000000..0aa3e09186b --- /dev/null +++ b/tests/exception/twrong_handler.nim @@ -0,0 +1,26 @@ +discard """ + description: ''' + Ensure that the correct except branch is jumped to after exiting a try + block through unstructured, but non-exceptional, control-flow. + ''' +""" + +proc test(doExit: bool): bool = + try: + block exit: + try: + if doExit: + break exit + else: + discard "fall through" + except ValueError: + doAssert false, "unreachable" + + # the above except branch previously caught the exception + raise ValueError.newException("a") + except ValueError as e: + doAssert e.msg == "a" + result = true + +doAssert test(true) +doAssert test(false) \ No newline at end of file From 6e9f7ec8dd525c634f9763137951ce7ddeb7b351 Mon Sep 17 00:00:00 2001 From: zerbina <100542850+zerbina@users.noreply.github.com> Date: Sun, 4 Feb 2024 18:13:54 +0000 Subject: [PATCH 07/11] tests: add a test for the "reraise-and-handle-in-finally" case It doesn't work at the moment, but it's also not entirely clear whether it actually should. --- tests/exception/thandle_in_finally.nim | 33 ++++++++++++++++++++++++++ 1 file changed, 33 insertions(+) create mode 100644 tests/exception/thandle_in_finally.nim diff --git a/tests/exception/thandle_in_finally.nim b/tests/exception/thandle_in_finally.nim new file mode 100644 index 00000000000..c803c8a52d5 --- /dev/null +++ b/tests/exception/thandle_in_finally.nim @@ -0,0 +1,33 @@ +discard """ + description: ''' + Ensure that a finally clause can fully handle an exception by re-raising + and catching it + ''' + knownIssue.c js vm: ''' + Not implemented properly by the code generator and/or runtime + ''' +""" + +# XXX: it's questionable whether this really should work / be allowed + +var steps: seq[int] + +try: + try: + raise CatchableError.newException("a") + finally: + try: + raise # re-raise the active exception + except CatchableError: + # catch the exception + steps.add 1 + # leaving this except handler means that the exception is handled + steps.add 2 + doAssert getCurrentException() == nil + # unwinding doesn't continue when leaving the finally + steps.add 3 +except CatchableError: + # never reached, since the excepti + doAssert false, "unreachable" + +doAssert steps == [1, 2] \ No newline at end of file From 8d683571bf534bb16887f3eed7e05d235fad40d6 Mon Sep 17 00:00:00 2001 From: zerbina <100542850+zerbina@users.noreply.github.com> Date: Sun, 4 Feb 2024 18:35:57 +0000 Subject: [PATCH 08/11] post-merge fix-up `initIntReg` changed to doing the register cleanup itself. --- compiler/vm/vm.nim | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/compiler/vm/vm.nim b/compiler/vm/vm.nim index 20f7cecb036..7ef25b891e1 100644 --- a/compiler/vm/vm.nim +++ b/compiler/vm/vm.nim @@ -639,8 +639,7 @@ proc handle(res: sink Result[PrgCtr, VmException], c: var TCtx, if c.code[result].opcode == opcFinally: # setup the finally section's control register let reg = c.code[result].regA - t.sframes[^1].slots[reg].cleanUpReg(c.memory) - t.sframes[^1].slots[reg].initIntReg(fromEhBit or t.ehStack.high) + t.sframes[^1].slots[reg].initIntReg(fromEhBit or t.ehStack.high, c.memory) inc result else: @@ -2074,8 +2073,7 @@ proc rawExecute(c: var TCtx, t: var VmThread, pc: var int): YieldReason = if c.code[target].opcode == opcFinally: # remember where to jump back when leaving the finally section let reg = c.code[target].regA - regs[reg].cleanUpReg(c.memory) - regs[reg].initIntReg(pc + 1) + regs[reg].initIntReg(pc + 1, c.memory) # jump to the instruction following the 'Finally' pc = target else: From 1b51e92bf5747b52f417137f900891365d061cf0 Mon Sep 17 00:00:00 2001 From: zerbina <100542850+zerbina@users.noreply.github.com> Date: Sun, 4 Feb 2024 23:37:41 +0100 Subject: [PATCH 09/11] fix multiple typos in comments Co-authored-by: Saem Ghani --- tests/exception/tfinally6.nim | 2 +- tests/exception/thandle_in_finally.nim | 2 +- tests/exception/tleave_except.nim | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/exception/tfinally6.nim b/tests/exception/tfinally6.nim index 9bb9b5d14ae..113a747c78c 100644 --- a/tests/exception/tfinally6.nim +++ b/tests/exception/tfinally6.nim @@ -69,7 +69,7 @@ test reraiseFromFinally(), [1, 2, 3] proc exceptionInFinally() = ## Raise, and fully handle, an exception within a finally clause that was - ## entered through exceptionl control-flow. + ## entered through exceptional control-flow. try: try: raise ValueError.newException("a") diff --git a/tests/exception/thandle_in_finally.nim b/tests/exception/thandle_in_finally.nim index c803c8a52d5..00e503c06e0 100644 --- a/tests/exception/thandle_in_finally.nim +++ b/tests/exception/thandle_in_finally.nim @@ -27,7 +27,7 @@ try: # unwinding doesn't continue when leaving the finally steps.add 3 except CatchableError: - # never reached, since the excepti + # never reached, since the exception was handled above doAssert false, "unreachable" doAssert steps == [1, 2] \ No newline at end of file diff --git a/tests/exception/tleave_except.nim b/tests/exception/tleave_except.nim index a49091a08e3..f85a9f383dd 100644 --- a/tests/exception/tleave_except.nim +++ b/tests/exception/tleave_except.nim @@ -27,4 +27,4 @@ steps.add 2 doAssert getCurrentException() == nil, "current exception was cleared" doAssert steps == [1, 2] -echo "done" # ensures that the assertion weren't jumped over +echo "done" # ensures that the assertions weren't jumped over From 960185a45eed5f006603d590ef3926fd901c911f Mon Sep 17 00:00:00 2001 From: zerbina <100542850+zerbina@users.noreply.github.com> Date: Sun, 4 Feb 2024 23:38:40 +0100 Subject: [PATCH 10/11] tests: add extra assertion Co-authored-by: Saem Ghani --- tests/exception/traise_and_handle_in_except.nim | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/exception/traise_and_handle_in_except.nim b/tests/exception/traise_and_handle_in_except.nim index 15078d14257..f970a91594d 100644 --- a/tests/exception/traise_and_handle_in_except.nim +++ b/tests/exception/traise_and_handle_in_except.nim @@ -22,6 +22,7 @@ except ValueError as e: steps.add 3 # make sure the current exception is still the correct one + doAssert e.msg == "a" doAssert getCurrentException() == e steps.add 4 From 7a0a245fc3d2606d891d254d78a179f429b13f4d Mon Sep 17 00:00:00 2001 From: zerbina <100542850+zerbina@users.noreply.github.com> Date: Mon, 5 Feb 2024 01:05:21 +0000 Subject: [PATCH 11/11] tests: update the `thandle_in_finally` test * reword the description to better highlight the uncertainty * change the test's success condition to all three steps * fix the test running forever due the signal handler being entered over and over --- tests/exception/thandle_in_finally.nim | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/tests/exception/thandle_in_finally.nim b/tests/exception/thandle_in_finally.nim index 00e503c06e0..968ebfcd8ca 100644 --- a/tests/exception/thandle_in_finally.nim +++ b/tests/exception/thandle_in_finally.nim @@ -1,14 +1,15 @@ discard """ description: ''' - Ensure that a finally clause can fully handle an exception by re-raising - and catching it - ''' - knownIssue.c js vm: ''' - Not implemented properly by the code generator and/or runtime + A test for tracking the (uncertain) behaviour of entering a `finally` + clause through an exception, handling the exception within the + `finally`, and then leaving through structured control-flow. ''' + matrix: "-d:noSignalHandler" + knownIssue: "true" """ -# XXX: it's questionable whether this really should work / be allowed +# XXX: disabling the signal handler is currently necessary for the test +# to crash rather than entering an infinite loop var steps: seq[int] @@ -24,10 +25,11 @@ try: # leaving this except handler means that the exception is handled steps.add 2 doAssert getCurrentException() == nil - # unwinding doesn't continue when leaving the finally + # unwinding cannot continue when leaving the finally, since no exception + # is active anymore steps.add 3 except CatchableError: # never reached, since the exception was handled above doAssert false, "unreachable" -doAssert steps == [1, 2] \ No newline at end of file +doAssert steps == [1, 2, 3] \ No newline at end of file