diff --git a/compiler/ast/nimsets.nim b/compiler/ast/nimsets.nim index f3a9cb187a4..667753d0ae6 100644 --- a/compiler/ast/nimsets.nim +++ b/compiler/ast/nimsets.nim @@ -66,7 +66,9 @@ proc someInSet*(s: PNode, a, b: PNode): bool = proc inclTreeSet*(result: var TBitSetView, conf: ConfigRef; s: PNode) = ## Includes all elements from tree-set `s` into `result` - assert result.len == int(getSize(conf, s.typ)) + # XXX: requiring the length to fit might help in catching some issues, but + # it's too restrictive + assert result.len >= int(getSize(conf, s.typ)) var first, j: Int128 first = firstOrd(conf, s.typ[0]) for i in 0.. 0: return # issue #9933 - if conf.symbolFiles == disabledSf: + if isDefined(graph.config, "cbackend2"): + cbackend2.generateCode(graph) + elif conf.symbolFiles == disabledSf: cgenWriteModules(graph.backend, conf) else: if isDefined(conf, "nimIcIntegrityChecks"): diff --git a/compiler/sem/sighashes.nim b/compiler/sem/sighashes.nim index 0f7081b965a..dc3954a19f3 100644 --- a/compiler/sem/sighashes.nim +++ b/compiler/sem/sighashes.nim @@ -51,9 +51,9 @@ type CoDistinct CoHashTypeInsideNode -proc hashType(c: var MD5Context, t: PType; flags: set[ConsiderFlag]) +func hashType(c: var MD5Context, t: PType; flags: set[ConsiderFlag]) -proc hashSym(c: var MD5Context, s: PSym) = +func hashSym(c: var MD5Context, s: PSym) = if sfAnon in s.flags or s.kind == skGenericParam: c &= ":anon" else: @@ -63,7 +63,7 @@ proc hashSym(c: var MD5Context, s: PSym) = c &= "." it = it.owner -proc hashTypeSym(c: var MD5Context, s: PSym) = +func hashTypeSym(c: var MD5Context, s: PSym) = if sfAnon in s.flags or s.kind == skGenericParam: c &= ":anon" else: @@ -76,7 +76,7 @@ proc hashTypeSym(c: var MD5Context, s: PSym) = c &= "." it = it.owner -proc hashTree(c: var MD5Context, n: PNode; flags: set[ConsiderFlag]) = +func hashTree(c: var MD5Context, n: PNode; flags: set[ConsiderFlag]) = if n == nil: c &= "\255" return @@ -103,7 +103,7 @@ proc hashTree(c: var MD5Context, n: PNode; flags: set[ConsiderFlag]) = else: for i in 0.. 1) order by hash; -proc hashType*(t: PType; flags: set[ConsiderFlag] = {CoType}): SigHash = +func hashType*(t: PType; flags: set[ConsiderFlag] = {CoType}): SigHash = var c: MD5Context md5Init c hashType c, t, flags+{CoOwnerSig} diff --git a/compiler/vm/README.md b/compiler/vm/README.md new file mode 100644 index 00000000000..15057e0f01f --- /dev/null +++ b/compiler/vm/README.md @@ -0,0 +1,170 @@ + +All of the IR related work is currently located in the `vm` directory, since the IR originally started out as an IR for only the VM. + +Things to consider when reading the code: +* more or less everything is still a work in progress +* there's a lot of debug code lying around +* there's lots of outdated and stale code +* most outdated or unfinished parts aren't marked as such +* most of the existing documentation is unfinished or outdated +* some comments (general ones, `XXX` and `TODO`) are outdated and don't apply anymore + +The general approach for the new compiler backend is the following: +* take the `PNode`-AST that comes out of `transf` and translate it into a dedicated intermediate representation used until code generation +* apply transformations not specific to a target to the IR +* apply target-specific transformations to the IR +* pass the IR to the target's code-generator + +Some future directions and missing pieces are also documented here, but not all of them. + +## Overview of the added modules + +### `vmir.nim` + +The module still has it's original name, but the IR is fully decoupled from the VM. A lot of old code from previous iterations is in here. + +The relevant parts are: +* `IrNode3`: the type of the IR's node structure. Currently a variant object, but planned to move to a more generalized representation. +* `IrStore3`: stores the nodes together with the extra data needed (referenced symbols, join target, etc.). Generally refered to as **the** IR. A simple mechanism for tracking where in the compiler each `IrNode3` was added (or modified). This currently just uses stack-traces, but is planned to be expanded into a more proper facility to track node modifications. +* `BuiltinCall`: meant as an extension to magics, except that they're only needed in the backend. Introduced in order to not require changes to the `TMagic` enum. +* `IrCursor`: API to modify the IR. It first records all modifications and then applies them. Not very efficient right now. This might replace the older `irXXX`-procedure based IR generation (I'm not sure yet) + +Other parts: +* `genCodeV3Exec`: a very early prototype of a code-generator for the VM, taking the IR as input and producing VM bytecode +* `IrStore`, `IrNode2`: old attempts at the IR. Still kept around since there are some parts that might be reused +* `computeInlining`: an early, non-working prototype of computing the most memory efficient IR generation order in the context of procedure inlining + +#### IR overview: +* the IR is a linear node-based representation +* nodes reference each other via indices. A node can only reference nodes coming before it; reference cycles are forbidden +* it's still undecided if a node may be referenced multiple times +* control-flow is represented via gotos and joins. Instead of storing the index of the corresponding `join` target, a `goto` stores an index (`JoinPoint`) into a list storing the actual IR indices. This is aimed at making IR modification simpler, by removing the need to patch goto targets in the IR directly. +* there exist a few special experimental gotos (goto-link-back, goto-with-continuation, goto-active-continuation) meant for more efficient `finally` handling +* the implementation is currently not very data-oriented, but the plan is to move it there eventually. + + +### `irgen.nim` + +A heavily modified copy of `vmgen.nim`. Takes a post-`transf` procedure's `PNode`-AST as the input and translates it to the IR. Traverses the input AST and emits IR instructions via the various `irXXX` procedures. + +`irXXX` procedures defined in `irgen` are experimental and don't have a corresponding IR instruction (yet), but use a combination of other IR instructions. + +### `irpasses.nim` + +Implements the existing IR transformations. This currently includes general transformations as well as target specific ones. The target-specific passes will be moved to their own modules later on. Most transformations are exposed via the `LinearPass` interface. + +None of existing passes are finished yet. + +`runV2` implements the base for static-control-flow-based analysis (e.g. alias analysis, last-read-write analysis, escape analysis, etc.). + +An overview of the current passes: + +#### `computeAliases` + +Old, unused, and defunct early prototype of the alias analysis. + +#### `computeDestructors` + +Old, unused, and defunct early prototype of the destructor injection pass. + +#### `hookPass` + +Meant to replace assignments and `mDestroy` calls with calls to the `=copy`, `=sink` and `=destroy` hooks (if they are present). This is a general pass that applies to all targets and garbage collectors. + +Introduced before `LinearPass2` existed and is thus missing the `mDestroy` patching. + +Currently also ignores whether or not a hook is trivial and thus replaces the assignment for types that don't actually need/use a `=copy` hook. + +#### `refcPass` + +Used when the `refc` GC is enabled. Transforms `ref` (and erroneously also `seq` and `string`) assignments; lifts GC visit procs; lowers `new`, etc + +The GC visit procedure lifting is not yet implemented. + +Doing the lifting in a separate pass would allow for the `refcPass` to also be applicable to the `markAndSweep` and `boehm` GCs. With some additional adjustments the `go` could also be included in that list. + +#### `seqsV1Pass` + +Lowers `seq`s to `PGenericSeq` based operations. Meant for the C-like targets and used when `optSeqDestructors` (implied by ARC/ORC) is not enabled. + +All references to `seq` types need to be rewritten to use the `PGenericSeq` based type. Since seqs are generic, the new types need to be created as part of the pass (implemented). + +The types of locals, globals an parametes are currently adjusted (in a rather in-elegant manner), but field types also need to adjusted! This is not easily doable with the current surrounding architecture and a rewrite of how the types are adjusted is planned. + +A better approach for the type rewriting part would be to introduce a new kind of pass that operates only on types. `cbackend2` is then responsible for collecting all used types (this makes sense in general). The types could then also be run through a unification step, since most of the time, multiple `PType` instances exist for the exact same type (the VM also does this unification). + +As a further improvement, the IR should use it's own representation of types and symbols (a very early prototype exists in `irtypes.nim`). + +#### `seqsV2Pass` + +Same as `seqsV1Pass`, but uses `NimSeqV2`. Also meant for the C-like targets and used when `optSeqDestructors` is enabled. + + +#### `typeV1Pass` + +Creates globals to hold the used RTTI and also generates their initialization logic. Transforms usage of `mGetTypeInfo` to use the introduced globals. Meant for the C-like and JS targets. + +The initialization logic generation is not implemented yet. + + +#### `lowerTestError` + +Injects the pieces necessary for the `exceptions:goto` implementation on the C-like and JS targets. Not needed for the VM. + +#### `lowerRangeCheckPass` + +Transforms `bcRangeCheck` (coming from `nkRangeChck`) into comparisons plus `raiseRangeErrorXXX` calls. Meant to be a general pass, applying to all targets (except maybe the VM, since it currently does the checks at the instruction level). + +#### `lowerSetsPass` + +Lowers `set` operations into bit operations on integers and arrays. Meant for the C-like targets. + +The required replacing of `set` types is missing. + +### `irtypes.nim` + +Very early and not yet used prototype of a type representation for the backend. + +Using a dedicated type (symbols too) representation for the backend stage would mean that `PType` (and `PSym`) no longer has to accomodate for backend specific needs. + +It also allows for using a more linear, data-oriented approach for storing the types without having to adjust all of the compiler. Since the backend is written with a data-oriented approach in mind, it would greatly benefit from this. + + +### `cbackend2.nim` + +A copy of `vmbacked.nim` with the VM related bits removed. Adjusted to use the IR and `cgen2`. + +Points of interest: +* `generateCode`: orchestrates IR generation for all alive procedures (`method` handling is missing) and calls the code-generator (`cgen2`) + +**Note**: the DCE implementation currently runs before any IR transformations took place and thus doesn't know about used compilerprocs and some magics. + +Semantic analysis and backend processing happen separate from each other. That is, first the semantic analysis for the whole program is performed and only then is the backend executed. + +Pros: +* makes it easier to reason about the compiler +* compilerprocs in `system.nim` can be declared in any order, since once the backend is reached, all of them are available +* whole-program optimizations become possible + +Cons: +* higher memory usage, since the bodies of all semantically analysed procedures need to be kept alive until the backend stage +* errors occuring in the back-end are only reported much later (but these error should only be internal ones, this shouldn't be a problem in practice) + +For what it's worth, the VM backend (`vmbackend`) and the `PackedNode`-based backend (`cbackend`) meant for IC both also use the approach described here. + +The backend only supports running it against the whole program right now, but it's written in a way that makes it easy to support smaller, more granular working sets. + +### `cgen2.nim` + +The code-generator for the C target. It takes the IR for all procedures in a module, translates them to a simple AST, and then emits the latter to the given output file. + +The first iteration concatenated strings together with the plan to move to an AST-based approach later on, but I quickly figured that doing the switch already would make thing much simpler (and it did!). Some remnants of the original approach are still visible however. + +Types currently use their own IR in order to make the whole dependency discovery easier. I'd consider the whole approach to type handling here wrong however. Figuring out the order in which types need to be emitted is not a problem specific to the C target and should thus be done outside of the C code-generator (this is also what's planned). + +Instead of always writing to a file, it might make sense to pass `emitModuleToFile` a `Stream` instead and let the caller decide on where the output should go. + +Points of interest: +* `genCode`: translates the input IR to the simple C AST +* `genCTypeDecl`: translates `PType` to a `CDecl` +* `emitModuleToFile`: the main entry point into the code generator. Orchestrates the C AST and type declaration generation and then emits everything in the correct order. \ No newline at end of file diff --git a/compiler/vm/bitsetutils.nim b/compiler/vm/bitsetutils.nim new file mode 100644 index 00000000000..02152bd273a --- /dev/null +++ b/compiler/vm/bitsetutils.nim @@ -0,0 +1,40 @@ +## This module implements bit-sets supporting an arbitrary amount of elements. +## The implementation is a thin, type-safe wrapper around +## ``compiler/utils/bitsets``. + +# TODO: apply some polish (documentation, cleanup, etc.) and move this module +# to ``compiler/utils`` + +import compiler/utils/bitsets + +export bitsets + +type BitSet*[T: Ordinal] = object + data: TBitSet + +func newBitSet*[T](_: typedesc[T], elems: Natural): BitSet[T] = + result.data.bitSetInit((elems + 7) div 8) + +func incl*[T](x: var BitSet[T], elem: T) {.inline.} = + x.data.bitSetIncl(elem.BiggestInt) + +func excl*[T](x: var BitSet[T], elem: T) {.inline.} = + x.data.bitSetExcl(elem.BiggestInt) + +func contains*[T](x: BitSet[T], elem: T): bool {.inline.} = + x.data.bitSetIn(elem.BiggestInt) + +func containsOrIncl*[T](x: BitSet[T], elem: T): bool {.inline.} = + result = elem in x + if not result: + x.incl elem + +iterator items*[T](x: BitSet[T]): T = + var i = 0 + let L = x.data.len * 8 + while i < L: + let b = x.data[i shr 3] + if b shr (i and 7) != 0: + yield T(i) + + inc i diff --git a/compiler/vm/cbackend2.nim b/compiler/vm/cbackend2.nim new file mode 100644 index 00000000000..3e730e80d0f --- /dev/null +++ b/compiler/vm/cbackend2.nim @@ -0,0 +1,1097 @@ +import + std/[ + intsets, + tables + ], + compiler/ast/[ + ast, + ast_types, + astalgo, # for `getModule`, + idents, + lineinfos, + reports + ], + compiler/backend/[ + extccomp + ], + compiler/front/[ + msgs, + options + ], + compiler/modules/[ + magicsys, + modulegraphs + ], + compiler/sem/[ + passes, + transf + ], + compiler/utils/[ + pathutils + ], + compiler/vm/[ + cpasses, + irgen, + irtypes, + markergen, + vmir, + cgen2, + irpasses, + irdbg, + typeinfogen, + typeprocessing + ], + experimental/[ + results + ] + +from compiler/vm/vmdef import unreachable + +import std/options as stdoptions + +type + CodeFragment = object + ## The state required for generating code in multiple steps. + ## `CodeFragment` helps when generating code for multiple procedures in + ## an interleaved manner. + prc: PProc + irs: IrStore3 + + Module = object + stmts: seq[PNode] ## top level statements in the order they were parsed + sym: PSym ## module symbol + + ModuleDataExtra = object + ## Extra data associated with a module + # XXX: since this is data that's somewhat relevant to all targets, it + # might be a good idea to merge ``ModuleDataExtra`` with + # ``ModuleData``. The way in which the data for modules is organized + # needs an overhaul in general. + fileIdx: FileIndex + flags: TSymFlags + + initProc: ProcId ## the 'init' procedure for the module. May be unset + dataInitProc: ProcId ## + ## the procedure responsible for: + ## * intializing RTTI related to the module + ## * running dynamic-library loading logic + + # XXX: ``dataInitProc`` is not relevant to the VM target. Maybe the field + # should be split off? + + # TODO: turn into a ``distinct uint32`` + ModuleId = int ## The ID of a module in the back-end + + ModuleListRef = ref ModuleList + ModuleList = object of RootObj + modules: seq[Module] ## ``ModuleId`` -> data collected via the ``passes`` + ## interface + + # XXX: ``modulesClosed`` and ``moduleMap`` should be split off into a + # separate object. They're relevant until the end of ``generateCode``, + # while ``modules`` gets processed at the start and is then discarded + modulesClosed: seq[ModuleId] ## the modules in the order they were closed. + ## The first closed module comes first, then + ## the next, etc. + moduleMap: Table[int32, ModuleId] ## maps the module IDs used by semantic + ## analysis to the ones used in the + ## back-end + # TODO: use a ``seq`` instead of a ``Table`` + + ModuleRef = ref object of TPassContext + ## The pass context for the VM backend. Represents a reference to a + ## module in the module list + list: ModuleListRef + index: int + +func growBy[T](x: var seq[T], n: Natural) {.inline.} = + x.setLen(x.len + n) + +iterator cpairs[T](s: seq[T]): (int, lent T) = + ## Continous pair iterator. Supports `s` growing during iteration + var i = 0 + while i < s.len: + yield (i, s[i]) + inc i + +func collect(list: var seq[PSym], s: sink PSym, marker: var IntSet) {.inline.} = + ## If `s.id` is not present in `marker`, adds `s` to `list` and remember it + ## in `markers` + if not marker.containsOrIncl(s.id): + list.add s + +# TODO: rename to ``collectProcedureSyms`` +func collectRoutineSyms(ast: PNode, syms: var seq[PSym], marker: var IntSet) = + ## Traverses the `ast` and collects all referenced symbols of routine kind + ## to `syms` and `marker` + if ast.kind == nkSym: + let s = ast.sym + if s.kind in routineKinds: + collect(syms, s, marker) + + return + + for i in 0.. 1: newTree(nkStmtList, module.stmts) + elif module.stmts.len == 1: module.stmts[0] + else: newNode(nkEmpty) + + let tn = transformStmt(c.graph, c.idgen, c.module, ast) + let r = c.genStmt(tn) + + if unlikely(r.isErr): + config.localReport(r.takeErr) + + c.endProc() + + if c.irs.len > 2: + # call to ``nimTestErrorFlag`` at the very end of every 'init' procedure + # in order to report any unhandled exception + discard c.irs.irCall( + c.irs.irProc(c.passEnv.getCompilerProc("nimTestErrorFlag"))) + + # if the resulting procedure is empty, `irs` still has two items: the + # 'join's at the end + # TODO: use a more forward-compatible approach for testing if there's no + # code + result = + if c.irs.len > 2: some(move c.irs) + else: none(IrStore3) + +proc generateCodeForProc(c: var TCtx, s: PSym): IrGenResult = + assert s != nil + #debugEcho s.name.s, "(", s.kind, "): ", c.config.toFileLineCol(s.info) + let body = transformBody(c.graph, c.idgen, s, cache = false) + c.irs.reset() + c.options = s.options + result = genProc(c, s, body) + +proc unwrap[T](c: TCtx, r: Result[T, SemReport]): T = + if r.isErr: + c.config.localReport(r.takeErr) + else: + result = r.unsafeGet + +proc generateGlobalInit(c: var TCtx, f: var CodeFragment, defs: openArray[PNode]) = + ## Generates and emits code for the given `{.global.}` initialization + ## statements (`nkIdentDefs` in this case) into `f` + template swapState() = + #swap(c.code, f.code) + #swap(c.debug, f.debug) + swap(c.prc, f.prc) + + # In order to generate code into the fragment, the fragment's state is + # swapped with the `TCtx`'s one + swapState() + + for def in defs.items: + assert def.kind == nkIdentDefs + for i in 0.. 0: + # make sure that there's a slot for each known procedure in `bodies` + sync(bodies, c.procs) + + for sym in a.items: + let + id = c.procs.requestProc(sym) # TODO: use non-mutating lookup + idx = id.toIndex + + if sfImportc in sym.flags: + # a quick fix to not run `irgen` for 'importc'ed procs + bodies[idx].owner = id + continue + + let ir = c.unwrap generateCodeForProc(c, sym) + collectRoutineSyms(ir, c.procs, b, seenProcs) + + bodies[idx] = ir + bodies[idx].owner = id + + block: + let start = b.len + + # scan the collected constants for referenced procedures. The list only + # contains not-yet-scanned constants + for sym in c.collectedConsts.items: + collectRoutineSyms(astdef(sym), b, seenProcs) + + # clear the list so that the loop invariant mentioned above holds + c.collectedConsts.setLen(0) + + # register the routines with the environment + for i in start.. IR representation + var modules: seq[ModuleData] + var modulesExtra: seq[ModuleDataExtra] + # XXX: since both of them associate data with a module ID, and also share the + # same lifetime, merge them into a single sequence? + modules.newSeq(mlist.modules.len) + modulesExtra.newSeq(mlist.modules.len) + + var env = IrEnv() + + var seenProcs: IntSet + var nextProcs, nextProcs2: seq[PSym] + + var c = TCtx(config: g.config, graph: g, idgen: g.idgen) + c.magicPredicate = proc(m: TMagic): bool = m in CallMagics + swap(c.procs, env.procs) + swap(c.data, env.data) + c.types.voidType = g.getSysType(unknownLineInfo, tyVoid) + c.types.charType = g.getSysType(unknownLineInfo, tyChar) + + # setup a ``PassEnv`` + let passEnv = PassEnv() + passEnv.initSysTypes(g, env.types, c.types) + passEnv.initCompilerProcs(g, c.types, c.procs, c.defSyms, c.data) + + c.passEnv = passEnv + + # mark all compilerprocs as seen so that they don't get collected during + # the following dependency scanning + for it in g.compilerprocs.items: + if it.kind in routineKinds: + seenProcs.incl it.id + + # the range of definitely alive procedures starts after the compilerprocs + sync(procImpls, c.procs) + var aliveRange = procImpls.len..0 + + # generate all module init procecudres (i.e. code for the top-level + # statements): + for i, m in mlist.modules.cpairs: + # TODO: use ``lpairs`` (or ``pairs`` once it uses ``lent``) instead of + # ``cpairs`` + modulesExtra[i] = + ModuleDataExtra(fileIdx: m.sym.position.FileIndex, flags: m.sym.flags) + + c.module = m.sym + c.idgen = g.idgen + + var code = generateTopLevelStmts(m, c, g.config) + if code.isSome: + # the module needs an 'init' procedure + let id = c.procs.add(c.types.requestType(c.types.voidType), + g.cache.getIdent("init"), + keepName=false) + + # the logic for registering procedures with modules uses the source + # symbol tracked by ``ProcedureEnv.orig`` as the entity providing which + # module the procedure is owned by/attached to. We just pass the + # symbol of the module + # XXX: ``orig`` needs to be phased out. It's only reamining purpose is + # to keep hacks working. To provide the "attached-to" information, + # either store the procedure's associated ``ModuleId`` in + # ``ProcHeader`` or attach it via a side-channel + c.procs.orig[id] = m.sym + + modulesExtra[i].initProc = id + # XXX: ``Option`` is missing a ``take`` procedure + addProcedure(procImpls, id, move code.get()) + + # we no longer need the ``mlist.modules`` list, so we reset it so that the + # the memory used by the collected top-level nodes can be reclaimed already + reset(mlist.modules) + + assert nextProcs.len == 0 + for it in modulesExtra.items: + if it.initProc != NoneProc: + collectRoutineSyms(procImpls[it.initProc.toIndex], + c.procs, nextProcs, seenProcs) + + # run the dependency collection/``irgen`` loop using the procedures + # referenced by top-level statements as the starting set + drain(c, g.config, env, procImpls, nextProcs, nextProcs2, seenProcs) + + aliveRange.b = procImpls.high + # `aliveRange` is now the slice of all definitely alive procedures + + block: + # compilerprocs are a bit tricky to handle. We don't know if one of them can + # be considered 'alive' (used) until after all IR transformation took place. + # But at that point, it's too late for scanning/processing the used + # compilerprocs since all processing is already done. To solve this, we + # scan and process all compilerprocs and their dependencies upfront, but + # only queue them for code-generation after a separate scanning (run after + # all IR transformation took place) yields that they're part of the alive + # graph + + # XXX: the current approach has the downside that code which may end up + # not being part of the alive graph is still put through all + # processing. A different approach would be to run all processing + # (dependency collection/irgen and the IR passes) in a loop until no + # more new dependencies are found + + # run ``irgen`` for compilerprocs and their (not yet seen) dependencies + for it in g.compilerprocs.items: + if it.kind in routineKinds: + nextProcs.add it + + drain(c, g.config, env, procImpls, nextProcs, nextProcs2, seenProcs) + + # generate all deferred symbols and declarations. ``c.defSyms`` should not + # be used past this point + flush(c.defSyms, g.cache, env.syms) + + # XXX: it would be better to also set the type during + # ``DeferredSymbols.flush``. But then the procedure needs access to a + # ``DeferredTypeGen`` object - which is a bit awkward, since + # ``DeferredTypeGen.flush`` requires a ``DeferredSymbol`` object + for id, s in env.syms.msymbols: + if (let orig = env.syms.orig.getOrDefault(id); orig != nil): + s.typ = c.types.requestType(orig.typ) + + # XXX: this is a problem. Resolving the type-bounds operation requires + # all alive types being present, but that isn't the case yet since + # the final flush hasn't happenend, but for that we need to call + # ``finish``, but we can't since we're still adding procedures + resolveTypeBoundOps(passEnv, g, c.types, c.procs) + + block: + # translate the literal data from it's ``PNode``-based representation + for id, data in c.constData.pairs: + assert env.syms[id].kind == skConst + env.syms.setData(id): add(c.data, c.procs, g.config, data) + + reset c.constData # no longer needed + + c.procs.finish(c.types, g.cache) + + block: + # flush all remaining deferred types. ``c.symEnv`` was consumed when + # flushing it, so we create a temporary new ``DeferredSymbol`` object here + var defSyms = initDeferredSyms(env.syms) + c.types.flush(env.types, defSyms, g.config) + c.types.flush2(env.types, c.data, g.config) + + flush(defSyms, g.cache, env.syms) + + # replace all placeholder type IDs + finishTypes(passEnv, c.types, procImpls, c.procs, env.syms) + + processObjects(passEnv, g.cache, env.types, env.syms, c.types.objects) + + swap(c.procs, env.procs) + swap(c.data, env.data) + + let objects = move c.types.objects + + # TODO: ``generateCode`` needs to be split up. Freeing the ``TCtx`` should + # happen automatically as part of stack-frame clean up + reset(c) # we no longer need the irgen context + + block: + # all alive globals are collected by now - register them with their + # owning module + + for id in env.syms.items: + let s = env.syms[id] + case s.kind + of skVar, skLet, skForVar: + let mIdx = mlist[].lookupModule(env.syms.orig[id]) + modules[mIdx].syms.add(id) + + else: + discard + + # HACK: in the context of RTTI, closure types are represented via a "fake" + # tuple type (one not matching the type they're lowered to). + # the later RTTI setup logic generation requires the types it processes to + # have corresponding entries in the `tfInfo` and `gcInfo` lookup tables, + # so the type has to be added to the environment before computing the + # tables + let fakeClosure = genFakeClosureType(env.types, passEnv) + + # XXX: mutable because they need to be swapped in and out of the ``RefcPassCtx``. + # In the case of ``tfInfo``, ``shallowCopy`` could be used, but it's + # only available for refc. For ARC/ORC ``.cursor`` would have to be + # used instead + var + tfInfo = computeTypeFieldStatus(passEnv, env.types, objects) + gcInfo = computeGcLookup(env.types) + + var lpCtx = LiftPassCtx(graph: passEnv, cache: g.cache, env: addr env) + var ttc = TypeTransformCtx(graph: passEnv, ic: g.cache) + var upc = initUntypedCtx(passEnv, addr env) # XXX: not mutated - should be ``let`` + + # XXX: instead of manually figuring out out passes are to be batched + # together, each pass should describe it's expectations and what it + # modifies/transforms, so that we can then let an algorithm figure out + # how to optimally batch a given set of passes + + block: + # the lowering of ``echo`` for the C-targets has to happen *before* + # transforming ``openArray``s because the pass inserts code that needs to + # also be transformed by the latter + for s, ir in mpairsId(procImpls, ProcId): + logError(ir, env, s): + runPass(ir, upc, lowerEchoPass) + + block: + # the ``openArray`` lowering has to happen separately + # TODO: explain why + # TODO: since the ``lowerOpenArrayPass`` doesn't mutate the procedures' + # parameters anymore, it should be possible to run it in a batch + # with others + var ctx: LowerOACtx + ctx.init(passEnv) + + for s, irs in mpairsId(procImpls, ProcId): + logError(irs, env, s): + runPass(irs, initTypeContext(irs, env), env, ctx, lowerOpenArrayPass) + + lowerOpenArrayTypes(ttc, env.types, env.syms) + + let destructorSeq = optSeqDestructors in conf.globalOptions + + block: + # if a non-v2 garbage collector (e.g. ``refc``, ``markAndSweep``, + # everything else that uses ``unsureAsgnRef``) is active, the sequence + # operation lowering has to happen before the GC transform pass + let seqPass = + if destructorSeq: + seqV1Pass #seqV2Pass + else: + seqV1Pass + + for s, irs in mpairsId(procImpls, ProcId): + logError(irs, env, s): + # the error-handling pass inserts new nodes (instead of replacing + # them), which might cause conflicts with other changes if performed + # concurrently. To be on the safe side, the changes are applied separately. + lowerErrorFlag(irs, passEnv, g.cache, env.types, env.procs, env.data, + env.syms) + + block: + var diff = initChanges(irs) + let typeCtx = initTypeContext(irs, env) + # TODO: resue the ``TypeContext`` object across the batches (and maybe + # the loop) + # hooks need to be resolved before injecting the garbage collector + # related logic + runPass2(irs, typeCtx, env, passEnv, diff, hookPass) + + # the changes done by this pass need to be visible to further + # passes, so it can't be run in the same batch + runPass2(irs, typeCtx, env, passEnv, diff, lowerMatchPass) + + apply(irs, diff) + + block: + # TODO: reuse the ``TypeContext`` object across the loop + # TODO: resue the ``Changes`` object + var diff = initChanges(irs) + runPass2(irs, initTypeContext(irs, env), env, passEnv, diff, seqPass) + runPass2(irs, diff, lpCtx, seqConstV1Pass) + + apply(irs, diff) + + if destructorSeq: + discard #lowerSeqTypesV2(ttc, env.types, env.syms) + else: + lowerSeqTypesV1(ttc, env.types, env.syms) + + # don't commit the type changes yet. The following passes still need access + # to the original type + # XXX: ideally they shouldn't. If sequence types were lowered to ``ref`` + # types, it wouldn't be necessary. *EDIT*: not quite. The RTTI bits + # still need to know about the original types + var remap: TypeMap + swap(remap, ttc.remap) + + for s, irs in mpairsId(procImpls, ProcId): + logError(irs, env, s): + block: + # the following passes all modify/replace different nodes and don't + # depend on each others changes, so they're run concurrently + var diff = initChanges(irs) + let typeCtx = initTypeContext(irs, env, remap) + + # TODO: don't swap the seqs in and out inside the loop -- do it once + # outside the loop + var rpCtx: RefcPassCtx + rpCtx.setupRefcPass(passEnv, typeCtx, env, irs) + template swapState() = + swap(rpCtx.tfInfo, tfInfo) + swap(rpCtx.gcLookup, gcInfo) + swapState() + + runPass2(irs, typeCtx, env, passEnv, diff, lowerRangeCheckPass) + runPass2(irs, typeCtx, env, passEnv, diff, lowerSetsPass) + + runPass2(irs, typeCtx, env, rpCtx, diff, refcPass) + + runPass2(irs, diff, upc, ofV1Pass) + + runPass2(irs, diff, lpCtx, setConstPass) + runPass2(irs, diff, lpCtx, arrayConstPass) + + apply(irs, diff) + + swapState() + + # TODO: lifting the type info needs to happen after the alive + # procedure detection. Otherwise, we're creating RTTI that isn't + # actually used + runPass(irs, lpCtx, typeV1Pass) + + + block: + # perform the C-target specific constant-data transformations. This has to + # happen *before* lowering types, as we need the original types + + # first, lift ``set|string|seq`` literals that are part of other constants + # into their own constants + liftSetConsts(env.syms, env.data, lpCtx.constCache, g.cache.getIdent("setConst"), env.types) + liftSeqConstsV1(env.syms, env.data, lpCtx.constCache, g.cache.getIdent("seqConst"), env.types) + + # TODO: merge the changes from both passes before applying them + transformSetConsts(passEnv, env.syms, env.data, env.types) + if optSeqDestructors in conf.globalOptions: + discard + else: + transformSeqConstsV1(passEnv, env.syms, env.data, env.types) + + # the ``set`` types need to be lowered before starting RTTI + # processing/generation + lowerSetTypes(ttc, env.types, env.syms) + + block: + let sysModuleId = mlist.moduleMap[g.systemModule.moduleId] + + # create a RTTI global for the fake closure type. This has to happen + # before the call to ``generateDependencies`` so that the latter includes + # the `fakeClosure` type in it's scanning + discard liftRttiGlobal(lpCtx, fakeClosure) + + generateDependencies(lpCtx.typeInfoMarker, env.syms, g.cache, passEnv, + env.types) + + # we don't know the owning module of the types corresponding to the + # lifted RTTI globals, so we simply add the globals to the system + # module + # XXX: this is different to what the current code-generator does + # XXX: instead, all RTTI globals and their initialization logic + # could be registered to a dedicated module (.c file) + for id in lpCtx.typeInfoMarker.values: + modules[sysModuleId].syms.add(id) + + let markers = generateMarkerProcs(lpCtx.typeInfoMarker, passEnv, gcInfo, + env.types, g.cache.getIdent("marker"), + env.procs, env.data, procImpls) + + # even though we know the marker procedures are all alive, we don't + # register them here, but defer that to the later alive analysis instead. + # XXX: maybe the `collected` set should already be available at this + # point, so that we can at least mark the procedures as alive + # the procedure registration logic needs information about the owning + # module + for id in markers.values: + # use the symbol of the system module as the original symbol for the + # marker procs. + # This is of course incorrect, but past this point, ``orig`` is only + # used to supply the module the proc is attached to, so this doesn't + # cause any problems + env.procs.orig[id] = g.systemModule + + var cr: IrCursor ## the cursor is used to accumulate the generated code + let (nodeArr, nodePtrArr) = + generateRttiInit(g, passEnv, gcInfo, tfInfo, fakeClosure, + lpCtx.typeInfoMarker, markers, env.data, env.syms, + g.cache, env.types, cr) + + # register the extra globals to the system module: + modules[sysModuleId].syms.add(nodeArr) + modules[sysModuleId].syms.add(nodePtrArr) + + # if enabled, generate the type names: + if isDefined(g.config, "nimTypeNames"): + generateTypeNames(lpCtx.typeInfoMarker, env.types, env.data, passEnv, g, + passEnv.compilerglobals["nimTypeRoot"], cr) + + # wrap the generated code into a procedure. For now, the data-init + # procedure of the ``system`` module is used for this + block: + let + code = finish(cr) + id = env.procs.add(passEnv.sysTypes[tyVoid], + g.cache.getIdent("DatInit"), keepName=false) + + addProcedure(procImpls, id, code) + + env.procs.orig[id] = g.systemModule + modulesExtra[sysModuleId].dataInitProc = id + + # now commit the lowered sequence-types + commit(env.types, remap) + + block: + # apply transformations meant for the C-like targets + var cenv: CTransformEnv + applyCTypeTransforms(cenv, passEnv, env.types, env.syms) + + let + ctx = CTransformCtx(graph: passEnv, transEnv: addr cenv) + paramName = g.cache.getIdent("ClE") + envName = env.syms.addDecl(g.cache.getIdent(":env")) + + for s, irs in mpairsId(procImpls, ProcId): + logError(irs, env, s): + block: + let typeCtx = initTypeContext(irs, env) + var diff = initChanges(irs) + + runPass2(irs, typeCtx, env, ctx, diff, ctransformPass) + runPass2(irs, typeCtx, env, ctx, diff, lowerClosuresPass) + transformContinue(irs, passEnv, env.data, diff) + + apply(irs, diff) + + transformClosureProc(passEnv, paramName, envName, s, env.procs, irs) + + finish(cenv, env.types) + + var mainProc: ProcId + block: + # generate and register the 'main' procedure + + # the code-generator must not mangle the name + mainProc = env.procs.add(passEnv.sysTypes[tyInt], + g.cache.getIdent("main"), keepName=true) + + # TODO: the 'argc', 'args', and 'env' parameters are missing, as well as + # the logic for assigning them to the corresponding globals + + addProcedure(procImpls, mainProc): + generateEntryProc(passEnv, mlist[], modulesExtra) + + # use the symbol of the project's main module as the source of the + # generated main procedure + env.procs.orig[mainProc] = g.ifaces[g.config.projectMainIdx2.int32].module + + template register(items: iterable[int]) = + ## Registers all procedures stored by index in `x` to the owning module + for it in items: + let + id = ProcId(it + 1) # TODO: not acceptable + sym = env.procs.orig[id] + mIdx = mlist[].lookupModule(sym) + + modules[mIdx].procs.add id + + # TODO: move this logic into a separate proc + block: + # `procImpls` is partitioned in the following way: + # +---------------+-----------------+------------+ + # | compilerprocs | explicitly used | additional | + # +---------------+-----------------+------------+ + # + # To figure out which procedures from the "compilerprocs" and "additional" + # partitions are actually used, an iterative dependency collection using + # the procedures in the "B" partition as the starting set is run + var collected: IntSet + var a, b: IntSet + + template markImpl(extra: untyped) {.dirty.} = + for n in code.nodes: + case n.kind + of ntkProc: + let elem = toIndex(n.procId).int + if elem notin ignore and extra: + next.incl elem + + else: + discard + + func mark(code: IrStore3, ignore: Slice[int], next: var IntSet) = + markImpl(): + true + + func mark2(code: IrStore3, ignore: Slice[int], alive: IntSet, next: var IntSet) = + markImpl(): + elem notin alive + + # calculate the starting set + for i in aliveRange.items: + mark(procImpls[i], aliveRange, a) + + # also include the main procedure in order for the data-init procs to be + # marked as alive + a.incl mainProc.toIndex.int + + # run the main collection + while a.len > 0: + collected.incl(a) + for it in a.items: + mark2(procImpls[it], aliveRange, collected, b) + + a.clear() + swap(a, b) + + # `collected` now stores all indirectly used procedures - register them + register(collected.items) + + # register all explicitly used procedures + register(aliveRange.items) + + var gCtx: GlobalGenCtx + initGlobalContext(gCtx, env) + + for i, m in modulesExtra.pairs: + if modules[i].syms.len == 0 and modules[i].procs.len == 0: + # don't generate anything for modules that have no alive content + continue + + let + cname = getCFile(conf, AbsoluteFile toFullPath(conf, m.fileIdx)) + cf = Cfile(nimname: g.ifaces[m.fileIdx.int].module.name.s, cname: cname, + obj: completeCfilePath(conf, toObjFile(conf, cname)), + flags: {}) + + emitModuleToFile(conf, cname, gCtx, env, procImpls, modules[i]) + + addFileToCompile(conf, cf) + + # code generation is finished + + +# Below is the `passes` interface implementation + +proc myOpen(graph: ModuleGraph, module: PSym, idgen: IdGenerator): PPassContext = + if graph.backend == nil: + graph.backend = ModuleListRef() + + let + mlist = ModuleListRef(graph.backend) + next = mlist.modules.len + id = module.itemId.module + + assert id >= 0 and id == module.position # sanity check + + # append an empty module to the list + mlist.modules.growBy(1) + mlist.modules[next] = Module(sym: module) + mlist.moduleMap[id] = next + + result = ModuleRef(list: mlist, index: next) + +proc myProcess(b: PPassContext, n: PNode): PNode = + result = n + let m = ModuleRef(b) + + # TODO: this doesn't work for modules consisting of only a single statement + if n.kind == nkStmtList: + m.list.modules[m.index].stmts.add(n) + +proc myClose(graph: ModuleGraph; b: PPassContext, n: PNode): PNode = + result = myProcess(b, n) + + let m = ModuleRef(b) + m.list.modulesClosed.add(m.index) + +const cgen2Pass* = makePass(myOpen, myProcess, myClose) \ No newline at end of file diff --git a/compiler/vm/cgen2.nim b/compiler/vm/cgen2.nim new file mode 100644 index 00000000000..3f510589b2c --- /dev/null +++ b/compiler/vm/cgen2.nim @@ -0,0 +1,2450 @@ +## `vmir`-based C code-generator. Separated into two phases: +## * code-gen: IR -> CAst, CDecl +## * emit: write CAst and CDecl to file + +# XXX: the current implementation still unnecessarily uses a separate +# ``CAst`` (a seq) for each sub-expression, causing a very large +# amount of temporary allocations. ``cgen2`` is very inefficient in +# general and is in need of an overhaul. Right now, more time is +# spent in the code-generator than in the other parts of the back-end +# *combined*. +# The improved design will likely consist of 3 ``seq[CAstNode]`` (1 for +# constants, 1 for the top-level statements of inline procedures, and 1 +# for their sub-expressions/statements) that are part of the +# ``GlobalGenCtx`` and 2 ``seq[CAstNode]`` that are part of a +# ``ModuleCtx`` + +import + std/[ + hashes, + packedsets, + sets, + strformat, + tables + ], + + compiler/ast/[ + ast_types, + ast_query, + wordrecg + ], + compiler/backend/[ + ccgutils + ], + compiler/front/[ + options, + msgs + ], + compiler/ic/[ + bitabs + ], + compiler/utils/[ + int128, + pathutils, + ropes + ], + compiler/vm/[ + irtypes, + vmir, + irdbg + ] + +import std/options as stdoptions + +from compiler/vm/vmdef import unreachable +from compiler/vm/vmaux import getEnvParam + +from compiler/sem/rodutils import toStrMaxPrecision + +from compiler/vm/irpasses import computeTypes, PassError + +type + TypeKey = TypeId + + LocalGenCtx = object + ## Mutable environmental state that only applies to the current item + ## (routine) that is being code-gen'ed + + ModuleCtx = object + ## Environmental state that is local to the module the IR being processed + ## lies in. + + # XXX: instead of using ``PackedSet``s here, ``TBitSet`` might be the + # better choice: + # - all operations are faster on them + # - it's simpler data-structure in general + # - it's trivial to iterate them in the order of ID values + # - better memory locality (it's just a seq) + # - except for resizing, no operations require allocations + # + # The only downside is that they on probably require more memory on + # average. + # The ordered iteration property could unlock alot of simplifications. + # For example, if it'd be enforced that for types and constants, + # items with a lower ID never depend on types with a higher ID, the + # quite complex logic for emitting them in the correct order can be + # turned into a simple for-loop + + types: PackedSet[TypeId] # all used type for the module + + syms: PackedSet[SymId] ## all used symbols that need to be declared in the C code. + funcs: PackedSet[ProcId] ## all used functions that need to be declared in the C code + + # TODO: header paths can be very regular. Maybe a CritBitTree[void} would make sense here? + # TODO: the header includes are currently emitted in an arbitrary order, is that okay? (check the old cgen) + headers: HashSet[string] ## all headers the module depends on + + COperator = enum + ## Currently only meant to name operators without having to + ## use the string representations directly. + # XXX: these could be sorted by precedence + copAdd = "+", copSub = "-", copMul = "*", copDiv="/", copMod="%", + copNot = "!" + copBitnot = "~", copBitand="&", copBitor="|", copBitxor="^" + copOr = "||" + copShl="<<", copShr=">>" + copEq="==", copNEq="!=", copLt="<", copLe="<=", copGt=">", copGe=">=" # comparison + copAsgn="=" + + CAstNodeKind = enum + ## Syntactic node + # TODO: reorder + cnkError # XXX: temporary. used to encode missing code-generator logic in the output + cnkStmtList + + cnkIf + cnkWhile + cnkSwitch + cnkCase + cnkCall + cnkReturn + cnkGoto + + cnkBraced # braced anonymous initializer + + cnkOpToken + + cnkCast + + cnkLabel # a "label x" + + cnkDotExpr + + cnkCharLit + cnkStrLit # string literal + cnkIntLit ## a 64-bit *unsigned* integer literal. ``a`` stores the high and + ## ``b`` the low bits + cnkFloat32Lit ## stores a 32-bit float value + cnkFloat64Lit ## stores a 64-bit float value + + cnkDef + cnkType + cnkTernary + cnkInfix + cnkPrefix + cnkIdent + cnkBracket + + # XXX: hmm, 3 byte wasted for padding + CAst = seq[tuple[kind: CAstNodeKind, a, b: uint32]] + + # TODO: use the correct names for the syntax constructs + CDeclAstNodeKind = enum + ## Basic AST for describing both the content of structs and types in C. + ## Not really a syntax tree. + cdnkStruct + cdnkField # type-decl + ident + cdnkUnion + + cdnkEmpty + + cdnkType # references another type via a ``CTypeId`` + cdnkWeakType # a "weak" reference to a type, meaning that a definition of + # the type doesn't have to be present in the translation unit + + cdnkIntLit # a unsigned integer literal (`a` encodes the low and `b` the high bits) + + cdnkFuncPtr # function-ptr type decl + cdnkPtr # XXX: strictly speaking, the `*` is part of the declarator and not of the specifier + cdnkBracket + cdnkIdent + + CDecl = seq[tuple[kind: CDeclAstNodeKind, a, b: uint32]] + + CTypeId = TypeId + + CIdent = LitId ## An identifier in the generated code + + CTypeInfo = object + decl: CDecl + name: CIdent # + + CProcHeader = object + ident: CIdent + + returnType: CTypeId + args: seq[tuple[typ: CTypeId, name: CIdent]] + + IdentCache = BiTable[string] + + GlobalGenCtx* = object + ## Environment state that applies to all to all code, independent from + ## which routine or module the code is in. + + # TODO: BiTable might not be the best choice. It recomputes the hash for the + # key on each entry comparison, as it doesn't store key hashes. + # `idents.IdentCache` could be used here, but it's very tailored to Nim (and + # also a `ref` type). Maybe a hash-table overlay (see + # ``vmdef.TypeTable``) is the better choice here + idents: IdentCache # identifiers used in the generated C-code + # XXX: the only remaining use for `strings` is error messages + strings: BiTable[string] + + funcs: seq[CProcHeader] + + symIdents: seq[CIdent] # maps each symbol *index* to an identifier + fieldIdents: seq[CIdent] # maps each field *index* to an identifier + + constInit: Table[SymId, CAst] ## the initializer for each constant + constDeps: Table[SymId, seq[SymId]] ## the dependencies on other constants + ## for each constant + + ctypes: seq[CTypeInfo] # + + NameScope = object + ## Stores all identifiers defined in a C scope. Used for resolving name conflicts + # XXX: use a different name? + idents: PackedSet[CIdent] + + CAstBuilder = object + ast: CAst + + ExprInfo = object + # TODO: manually implement the bitfield. C doesn't make guarantees + # regarding the layout and ``bitsize`` also doesn't work on the + # VM target + # TODO: only 4 bits are used - making use of a ``PackedSeq`` would reduce + # the amount of storage required + rc {.bitsize: 2.}: uint ## 0 = no referenced + ## 1 = referenced only once + ## 2 = referenced more than once + disjoint {.bitsize: 1.}: bool ## whether the expression is used in a + ## partition different from the one it's located in + hasSideEffect {.bitsize: 1.}: bool ## whether the expression has + ## side-effects + +const VoidCType = CTypeId(0) + +const InvalidCIdent = CIdent(0) # warning: this depends on a implementation detail of `BiTable` + +# ``char`` is an unsigned 8-bit value in NimSkull, so we just use ``NU8`` +# XXX: if this causes issues with ``cstring`` (which now is an +# ``unsigned char*``), ``unsigned char`` could be used +# instead +const CharType = "NU8" + +func enumToStrTbl[E: enum](_: typedesc[E]): array[E, string] = + for e in low(E)..high(E): + result[e] = $e + +const COpToStr = enumToStrTbl(COperator) + ## Maps a ``COperator`` to it's string representation. More efficient than + ## ``$COperator`` + +func `==`(a, b: CTypeId): bool {.borrow.} + +func formatHexChar(dst: var openArray[char], pos: int, x: uint8) = + const Chars = ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9', + 'a', 'b', 'c', 'd', 'e', 'f'] + dst[pos + 0] = Chars[x shr 4] + dst[pos + 1] = Chars[x and 0x0F] + +func formatOctChar(dst: var openArray[char], pos: int, x: uint8) = + const Chars = ['0', '1', '2', '3', '4', '5', '6', '7'] + dst[pos + 0] = Chars[x shr 6] + dst[pos + 1] = Chars[(x shr 3) and 0x07] + dst[pos + 2] = Chars[x and 0x07] + +func iface(syms: SymbolEnv, id: SymId): PSym = + # XXX: temporary solution + let orig = syms.orig.getOrDefault(id) + if orig != nil and sfImportc in orig.flags: + result = orig + +func mangledName(sym: PSym): string = + if {sfImportc, sfExportc} * sym.flags != {}: + $sym.loc.r + else: + fmt"{sym.owner.name.s}__{mangle(sym.name.s)}_{sym.typ.id}" + +# XXX: shared with ``ccgtypes`` +func isKeyword(w: PIdent): bool = + ## Tests if the identifier is a keyword in C + result = w.id in {ccgKeywordsLow..ccgKeywordsHigh, ord(wInline)} + +func mangledName(w: PIdent): string = + if isKeyword(w): + fmt"{w.s}_0" + else: + mangle(w.s) + +func mangledName(d: DeclarationV2): string = + # XXX: temporary + if d.forceName: + d.name.s + else: + mangledName(d.name) + +func mangledName(d: DeclarationV2, id: uint32): string = + # XXX: temporary + if d.forceName: + d.name.s + else: + fmt"{mangle(d.name.s)}_{id}" + +func mangledName(procs: ProcedureEnv, id: ProcId): string = + let decl = procs[id].decl + if decl.forceName: + decl.name.s + else: + # XXX: temporary fix in order to make overloading work + fmt"{mangle(decl.name.s)}_{id.uint32}" + +const BaseName = "Sup" ## the name of the field for the base type + +const ArrayInnerName = "arr" + +func add(decl: var CDecl, k: CDeclAstNodeKind; a, b: uint32 = 0) = + decl.add((k, a, 0'u32)) + +func addField(decl: var CDecl, typ: CTypeId, name: CIdent) = + decl.add cdnkField + decl.add cdnkType, typ.uint32 + decl.add cdnkIdent, name.uint32 + +func addField(decl: var CDecl, cache: var IdentCache, typ: CTypeId, name: sink string) {.inline.} = + decl.addField(typ, cache.getOrIncl(name)) + +func addIntLit(decl: var CDecl, i: uint64) {.inline.} = + decl.add cdnkIntLit, uint32(i and 0xFFFFFFFF'u64), uint32(i shr 32) + +type CTypeMap = Table[TypeKey, CTypeId] + +type TypeGenCtx = object + # inherited state + cache: IdentCache + env: ptr IrEnv + fieldIdents: seq[CIdent] # mutated + + # non-inherited state + weakTypes: set[TypeNodeKind] #ä the set of types that can be turned into + ## forward declarations when declared as a pointer + +func requestType(c: var TypeGenCtx, t: TypeId): CTypeId = + ## Requests the type-id for `t`. If the c-type for `t` doesn't exist yet, a + ## slot for it is reserved and it's added to the `c.forwared` list + # TODO: remove the procedure (or update it's doc comment) + CTypeId(t) + +func genRecordNode(c: var TypeGenCtx, decl: var CDecl, iter: var RecordIter): int = + let n = next(c.env.types, iter) + + case n.kind + of rnkList: + for _ in 0.. struct { T data[len] } + # Arrays are wrapped in a struct which allows for them to appear as return-types and in assignments + result.add cdnkStruct, 1.uint32 + result.add cdnkEmpty + + result.add cdnkField + # not a weak-dep, since the complete type is required + result.add cdnkType, c.requestType(c.env.types.elemType(t)).uint32 + result.add cdnkBracket + result.add cdnkIdent, c.cache.getOrIncl(ArrayInnerName).uint32 + result.addIntLit c.env.types.length(t).uint64 + + of tnkProc: + result.add cdnkFuncPtr, c.env.types.numParams(t).uint32 + result.addWeakType(c, c.env.types.getReturnType(t)) + + for it in c.env.types.params(t): + # function pointer declarations don't require complete types + result.addWeakType(c, it) + + of tnkRef, tnkPtr, tnkVar, tnkLent: + result.add cdnkPtr + # we only need a weak-dep for the pointer's element type + result.addWeakType(c, c.env.types.elemType(t)) + + of tnkUncheckedArray: + result.add cdnkBracket + result.add cdnkType, c.requestType(c.env.types.elemType(t)).uint32 + # ``SEQ_DECL_SIZE`` is a macro defined in ``nimbase.h`` + result.add cdnkIdent, c.cache.getOrIncl("SEQ_DECL_SIZE").uint32 + + of tnkCString: + result.add cdnkPtr + result.add cdnkIdent, c.cache.getOrIncl("unsigned char").uint32 + + else: + let kind = c.env.types[t].kind + result.add cdnkIdent, c.cache.getOrIncl(fmt"genCType_missing_{kind}").uint32 + + assert result.len > 0 + +func getTypeName(c: var IdentCache, env: TypeEnv, id: TypeId, decl: Declaration): CIdent = + if (let a = env.getAttachmentIndex(id); a.isSome): + let attach = env.getAttachment(a.unsafeGet) + if attach[1]: + c.getOrIncl(attach[0].s) + else: + c.getOrIncl(fmt"{mangle(attach[0].s)}_{id.uint32}") + else: + # some types require a definition and thus need a name + case env.kind(id) + of tnkProc: + c.getOrIncl(fmt"proc_{id.uint32}") + of tnkRecord: + # a record type without a name is always a tuple + c.getOrIncl(fmt"tuple_{id.uint32}") + of tnkArray, tnkUncheckedArray: + c.getOrIncl(fmt"array_{id.uint32}") + else: + # the other types don't need generated names + InvalidCIdent + +const AutoImported = {tnkVoid, tnkBool, tnkChar, tnkInt, tnkUInt, tnkFloat} # types that are treated as imported + +func genCTypeInfo(gen: var TypeGenCtx, env: TypeEnv, id: TypeId): CTypeInfo = + let t = env[id] + if (let iface = env.iface(id); iface != nil and sfImportc in iface.flags): + result = CTypeInfo(name: gen.cache.getOrIncl($iface.loc.r)) + elif t.kind in AutoImported: + let name = + case t.kind + of tnkVoid: "void" + of tnkChar: CharType + of tnkBool: "NIM_BOOL" + of tnkInt: + {.warning: "NI is never emitted anymore, as we can't detect an `int` here".} + fmt"NI{t.size}" + of tnkUInt: fmt"NU{t.size}" + of tnkFloat: fmt"NF{t.size}" + else: unreachable() + + result = CTypeInfo(name: gen.cache.getOrIncl(name)) + else: + let name = getTypeName(gen.cache, env, id, Declaration()) + var decl = genCTypeDecl(gen, id) + + # set the identifier field for struct and union types: + if decl[0].kind in {cdnkStruct, cdnkUnion}: + decl[1] = (cdnkIdent, name.uint32, 0'u32) + + result = CTypeInfo(decl: decl, name: name) + + +func useFunction(c: var ModuleCtx, s: ProcId) = + c.funcs.incl s + +func useType(c: var ModuleCtx, t: TypeId) = + assert t != NoneType + c.types.incl t + +type GenCtx = object + sym: ProcId + + names: seq[CAst] # IRIndex -> expr + exprs: seq[ExprInfo] + types: seq[TypeId] + config: ConfigRef + + scope: NameScope + localNames: seq[CIdent] + + env: #[lent]# ptr IrEnv + + gl: GlobalGenCtx # XXX: temporary + m: ModuleCtx # XXX: temporary + +func getUniqueName(scope: NameScope, cache: var IdentCache, name: string): CIdent = + ## Returns a name that is not already in use in the given `scope`. If the + ## given `name` is not in use, the corresponding identifier ID is returned. + ## Otherwise, `name` appended to with a number is returned. + ## Does **not** register the returned identifier with `scope`. + + result = cache.getOrIncl(name) + + if scope.idents.contains(result): + # an identifier with the requested name already exists + var buf = name + buf.add "_" + let origLen = buf.len + + var next = 10 + var i = 0 + while true: + while i < next: + buf.setLen(origLen) + buf.addInt(i) + result = cache.getOrIncl(buf) + if not scope.idents.contains(result): + return + + inc i + + # no free name was found in the previous range. Expand the search range. + # Not resetting `i` back to 0 means that we're wasting character space, + # but it also prevents `a_1` and `a_01` from both existing in the same + # scope + + next *= 10 + +func gen(c: GenCtx, irs: IrStore3, n: IRIndex): CAst = + c.names[n] + +func mapTypeV3(t: TypeId): CTypeId + +func mapTypeV2(c: var GenCtx, t: TypeId): CTypeId = + # TODO: unfinished + c.m.useType(t) # mark the type as used + mapTypeV3(t) + +func mapTypeV3(t: TypeId): CTypeId = + if t != NoneType: + # TODO: no ``NoneType`` should reach here + # XXX: maybe just have a ``NoneType`` -> ``VoidCType`` mapping in the table instead? + CTypeId(t) + else: + VoidCType + +func genCProcHeader(idents: var IdentCache, env: ProcedureEnv, s: ProcId): CProcHeader = + result.ident = idents.getOrIncl(mangledName(env, s)) + result.returnType = mapTypeV3(env.getReturnType(s)) + + result.args.newSeq(env.numParams(s)) + var i = 0 + for p in env.params(s): + let ident = + if p.name != nil: idents.getOrIncl(mangledName(p.name)) + else: idents.getOrIncl("_param" & $i) + + result.args[i] = (mapTypeV3(p.typ), + ident) + inc i + + +template start(): CAstBuilder = + var b: CAstBuilder + b + +template buildAst(code: untyped): CAst = + var builder {.inject.}: CAstBuilder + code + builder.fin() + +template void(c: CAstBuilder) = + ## Convenience routine meant for discarding the result of a builder call + ## chain + discard c + +func add(c: var CAstBuilder, kind: CAstNodeKind; a, b: uint32 = 0): var CAstBuilder = + result = c + c.ast.add (kind, a, b) + + +func add(x: var CAst, kind: CAstNodeKind; a, b: uint32 = 0) = + x.add (kind, a, b) + +func add(c: var CAstBuilder, other: CAst): var CAstBuilder = + result = c + c.ast.add(other) + +func emitDeref(c: var CAstBuilder): var CAstBuilder = + result = c + c.ast.add cnkPrefix + c.ast.add cnkOpToken, copMul.ord.uint32 + +func emitAddr(c: var CAstBuilder): var CAstBuilder = + result = c + c.ast.add cnkPrefix + c.ast.add cnkOpToken, copBitand.ord.uint32 + +func ident(c: var CAstBuilder, idents: var IdentCache, name: string): var CAstBuilder = + result = c + c.ast.add cnkIdent, idents.getOrIncl(name).uint32 + +func ident(c: var CAstBuilder, ident: CIdent): var CAstBuilder = + assert ident != InvalidCIdent + result = c + c.ast.add cnkIdent, ident.uint32 + +func op(c: var CAstBuilder, op: COperator): var CAstBuilder = + result = c + c.ast.add cnkOpToken, op.ord.uint32 + +func intLit(c: var CAstBuilder, v: BiggestUInt): var CAstBuilder = + result = c + c.ast.add cnkIntLit, uint32(v shr 32), uint32(v and 0xFFFFFFFF'u64) + +func strLit(c: var CAstBuilder, id: LiteralId): var CAstBuilder = + assert id.kind == lkString + result = c + c.ast.add cnkStrLit, id.uint32 + +func floatLit(c: var CAstBuilder, v: BiggestFloat): var CAstBuilder = + result = c + let bits = cast[uint64](v) + c.ast.add cnkFloat64Lit, uint32(bits shr 32), uint32(bits and 0xFFFFFFFF'u64) + +func sub(c: var CAstBuilder): var CAstBuilder = + result = c + +func fin(c: sink CAstBuilder): CAst = + swap(result, c.ast) # XXX: `swap` is used for refc-compatibility + +func genError(c: var GenCtx, str: string): CAst = + # XXX: cnkError always takes a string literal for now + result.add cnkError, c.gl.strings.getOrIncl(str).uint32 + +func genArithm(c: var GenCtx, i: IRIndex, check: bool): CAst = + c.genError("genArithm_missing") + +func getTypeArg(irs: IrStore3, arg: IRIndex): TypeId = + let arg = irs.at(arg) + case arg.kind + of ntkLit: + irs.getLit(arg).typ + else: + unreachable(arg.kind) + +func genBraced(elems: varargs[CAst]): CAst = + result.add cnkBraced, elems.len.uint32 + for it in elems.items: + result.add it + +func ident(c: var GlobalGenCtx, name: string): CAst = + result.add cnkIdent, c.idents.getOrIncl(name).uint32 + +func genBuiltin(c: var GenCtx, irs: IrStore3, bc: BuiltinCall, n: IRIndex): CAst = + template arg(i: Natural): IRIndex = + irs.args(n, i) + + case bc + of bcUnlikely: + start().add(cnkCall, 1).ident(c.gl.idents, "NIM_UNLIKELY").add(c.gen(irs, arg(0))).fin() + of bcError: + start().add(cnkCall, 1).ident(c.gl.idents, "IR_ERROR").strLit(irs.getLit(irs.at(arg(0))).val).fin() + else: + genError(c, fmt"missing: {bc}") + #unreachable(bc) + +# TODO: include ``mParseBiggestFloat`` back in the set once the issue +# described in ``cpasses`` is fixed +const CallMagics* = { mIsolate, mFinished, mDotDot, mEqCString, + mNewString, mNewStringOfCap, mExit #[, mParseBiggestFloat]# } + ## magics for which no special handling is needed, that is, they're treated + ## as normal procedures + +type MagicKind = enum + mkUnary + mkBinary + mkCall + +func genSimpleMagic(c: var CAstBuilder, ctx: GenCtx, irs: IrStore3, m: TMagic, n: IRIndex): bool = + let (kind, op) = + case m + of mNot: (mkUnary, copNot) + of mXor: (mkBinary, copNEq) + of mEqRef, mEqCh, mEqI, mEqB, mEqEnum, mEqF64, mEqProc: (mkBinary, copEq) + of mBitandI: (mkBinary, copBitand) + of mBitorI: (mkBinary, copBitor) + of mBitxorI: (mkBinary, copBitxor) + of mBitnotI: (mkUnary, copBitnot) + of mShlI: (mkBinary, copShl) + of mShrI, mAshrI: (mkBinary, copShr) + of mAddU, mAddI, mSucc, mAddF64: (mkBinary, copAdd) + of mSubU, mSubI, mPred, mSubF64: (mkBinary, copSub) + of mUnaryMinusI, mUnaryMinusI64, mUnaryMinusF64: (mkUnary, copSub) + of mUnaryPlusI, mUnaryPlusF64: (mkUnary, copAdd) + of mLtI, mLtF64, mLtU, mLtB, mLtCh, mLtEnum, mLtPtr: (mkBinary, copLt) + of mLeI, mLeF64, mLeU, mLeB, mLeCh, mLeEnum, mLePtr: (mkBinary, copLe) + of mMulI, mMulU, mMulF64: (mkBinary, copMul) + of mDivI, mDivU, mDivF64: (mkBinary, copDiv) + of mModI, mModU: (mkBinary, copMod) + of mOr: (mkBinary, copOr) + of mIsNil: + # a pointer value is implicitly convertible to a bool, so we use ``!x`` + # to test for nil + (mkUnary, copNot) + else: + # not a simple operator + return false + + template arg(i: Natural): IRIndex = + irs.args(n, i) + + case kind + of mkUnary: + # TODO: assert arg count == 1 + c.add(cnkPrefix).op(op).add(gen(ctx, irs, arg(0))).void() + of mkBinary: + c.add(cnkInfix).add(gen(ctx, irs, arg(0))).op(op).add(gen(ctx, irs, arg(1))).void() + else: + unreachable(kind) + + result = true + +func genMagic(c: var GenCtx, irs: IrStore3, m: TMagic, n: IRIndex): CAst = + template arg(i: Natural): IRIndex = + irs.args(n, i) + + block: + # see if the magic directly maps to a C operator + var ast = start() + if genSimpleMagic(ast, c, irs, m, n): + return ast.fin() + + # it doesn't + let (kind, sym) = + case m + of mSizeOf: (mkCall, "sizeof") + of mAlignOf: (mkCall, "NIM_ALIGNOF") + of mOffsetOf: + # --> offsetof(typename, fieldname) + let + a = gen(c, irs, arg(0)) + typ = irs.getLit(irs.at(arg(0))).typ + # TODO: the field position argument needs to a ``ntkImm`` + b = c.env.data.getInt(irs.getLit(irs.at(arg(1))).val) + return start().add(cnkCall, 2).ident(c.gl.idents, "offsetof").add(a).ident(c.gl.fieldIdents[c.env.types.nthField(typ, b.int).toIndex]).fin() + of mMinI, mMaxI: + # --> (a op b) ? a : b + let + a = gen(c, irs, arg(0)) + b = gen(c, irs, arg(1)) + op = if m == mMinI: copLe else: copGe + return start().add(cnkTernary).add(cnkInfix).add(a).op(op).add(b).add(a).add(b).fin() + of mAbsI: + # --> + # (a > 0) ? a : -a + let a = gen(c, irs, arg(0)) + return start().add(cnkTernary).add(cnkInfix).add(a).op(copGt).intLit(0).add(a).add(cnkPrefix).op(copSub).add(a).fin() + of mChr: + return start().add(cnkCast).ident(c.gl.idents, CharType).add(gen(c, irs, arg(0))).fin() + of mOrd: + # no-op + return c.gen(irs, arg(0)) + else: + return genError(c, fmt"missing magic: {m}") + + case kind + of mkUnary: + # TODO: assert arg count == 1 + result = start().add(cnkPrefix).ident(c.gl.idents, sym).add(gen(c, irs, arg(0))).fin() + of mkBinary: + result = start().add(cnkInfix).add(gen(c, irs, arg(0))).ident(c.gl.idents, sym).add(gen(c, irs, arg(1))).fin() + of mkCall: + var builder = start().add(cnkCall, irs.at(n).argCount.uint32).ident(c.gl.idents, sym) + for arg in irs.args(n): + discard builder.add(gen(c, irs, arg)) + + result = builder.fin() + +func genLit(ast: var CAstBuilder, c: var GenCtx, lit: LiteralId) = + ## Generates the AST for the given untyped literal `lit` + + # without type information, the only available piece of information we have + # is the shape of the literal + case lit.kind + of lkNumber: + # assume that it's a signed integer + let intVal = c.env.data.getInt(lit) + if intVal >= 0: + ast.intLit(intVal.BiggestUInt).void() + else: + let abs = not(cast[BiggestUInt](intVal)) + 1 + ast.add(cnkPrefix).op(copSub).intLit(abs).void() + + of lkString: + # treat as cstring + ast.strLit(lit).void() + of lkPacked, lkComplex: + # XXX: those can reach here, which is a symptom of proper garbage + # collection still missing for the procedure body IR. For + # example, the of-branch matching makes use of complex literals (a + # slice-list), but it's used as a leaf node, so it stays around as + # garbage. + # For now, we simply ignore them here + # XXX: with the addition of the unreferenced detection, untyped packed or + # complex literals should not be able to reach here anymore + # TODO: use ``unreachable`` again + #unreachable(lit.kind) + discard + +func genLit(ast: var CAstBuilder, c: var GenCtx, lit: LiteralId, typ: TypeId) = + case c.env.types.kind(typ) + of tnkInt: + let intVal = c.env.data.getInt(lit) + if intVal < 0: + # compute the two's-complement, yielding the absolute value. This works + # even if ``intVal == low(BiggestInt)``. + # XXX: Nim doesn't guarantee that a signed integer is stored in + # two's-complement encoding + let abs = not(cast[BiggestUInt](intVal)) + 1 + ast.add(cnkPrefix).op(copSub).intLit(abs).void() + else: + ast.intLit(intVal.BiggestUInt).void() + + of tnkUInt, tnkBool: + # a bool is also stored and emitted as a uint + ast.intLit(c.env.data.getUInt(lit)).void() + of tnkChar: + ast.add(cnkCharLit, c.env.data.getUInt(lit).uint32).void() + of tnkFloat: + let floatVal = c.env.data.getFloat(lit) + case c.env.types[typ].size + of 32: + ast.add(cnkFloat32Lit, cast[uint32](floatVal.float32)).void() + of 64, 128: + ast.floatLit(floatVal).void() + else: + unreachable() + + of tnkCString: + case lit.kind + of lkNumber: + # must be a nil-literal + assert c.env.data.getUInt(lit) == 0 + ast.ident(c.gl.idents, "NIM_NIL").void() + of lkString: + ast.strLit(lit).void() + else: + unreachable(lit.kind) + + of tnkPtr, tnkRef: + let intVal = c.env.data.getUInt(lit) + # XXX: not strictly necessary - only done for improved readability + if intVal == 0: + ast.ident(c.gl.idents, "NIM_NIL").void() + else: + # TODO: make sure this works across compilers - a cast might be needed + ast.intLit(intVal).void() + + of tnkProc: + # only 'nil' procedural literals use a ``LiteralId`` + # XXX: maybe that's not a good idea and an ``ntkProc`` with ``NoneProc`` + # should be used instead? + assert c.env.data.getUInt(lit) == 0 + ast.ident(c.gl.idents, "NIM_NIL").void() + else: + # TODO: use ``unreachable`` again + #unreachable(lit.kind) + ast.add(genError(c, fmt"missing lit: {c.env.types.kind(typ)}")).void() + +func genLit(c: var GenCtx, literal: Literal): CAst = + let lit = literal.val + if lit == NoneLit: + # `nil` as the value is used for type literals + start().add(cnkType, mapTypeV2(c, literal.typ).uint32).fin() + elif literal.typ != NoneType: + # a typed literal + # a cast to the given type is used in order to communicate the literal's + # type to C + buildAst: builder.add(cnkCast).add(cnkType, mapTypeV2(c, literal.typ).uint32).genLit(c, lit, literal.typ) + else: + # an untyped literal + # XXX: ideally, these shouldn't exist + buildAst: genLit(builder, c, lit) + +func startArrayInitializer(ast: var CAstBuilder, len: uint) = + # arrays are wrapped into a struct, so double braces have to be used + ast.add(cnkBraced, 1).void() # <- for the wrapper struct + # XXX: only array literals with a len <= 2^32 are supported... + ast.add(cnkBraced, len.uint32).void() + + +func genPackedArray(ast: var CAstBuilder, c: var GenCtx, data: LiteralData, lit: LiteralId) = + startArrayInitializer(ast, data.packedLen(lit).uint) + for u in data.uints(lit): + discard ast.intLit(u) + +func genDefaultVal(ast: var CAstBuilder, c: var GenCtx, id: TypeId) = + ## Generates the default value for the type with the given `id` + case c.env.types.kind(id) + of tnkBool, tnkChar, tnkInt, tnkUInt: + ast.intLit(0).void() + of tnkPtr, tnkRef: + ast.ident(c.gl.idents, "NIM_NIL").void() + + of tnkArray: + let L = c.env.types.length(id) + startArrayInitializer(ast, L) + + if L == 0: + # empty array; early out + return + + # the default value is the same across all elements, so we only create it + # once and then re-use it + let tmp = buildAst: builder.genDefaultVal(c, c.env.types.base(id)) + for _ in 0.. 0, "initializer missing" + + return ast.add(c.gl.constInit[sId]) + of conConstAddr: + # similar to ``conConst`` above, with the difference that we want the address + let sId = data.sym(iter).SymId + return ast.emitAddr().ident(c.gl.symIdents[sId.toIndex]) + else: + # no special handling + discard + + case c.env.types.kind(id) + of tnkChar, tnkBool, tnkInt, tnkUInt, tnkFloat, tnkCString, tnkPtr, tnkRef: + ast.genLit(c, data.getLit(iter), id) + of tnkProc: + ast.ident(c.gl.funcs[data.getExt(iter).ProcId.toIndex].ident).void() + of tnkArray: + let elemType = c.env.types.base(id) + var sub = iter.enter(data) + case sub.kind + of conLit: + # support string literals as the initializer for char arrays + let val = data.getLit(iter) + case val.kind + of lkString: + assert c.env.types.kind(elemType) == tnkChar, $c.env.types.kind(elemType) + ast.strLit(val).void() + of lkPacked: + assert data.packedLen(val).uint == c.env.types.length(id) + genPackedArray(ast, c, data, val) + else: + unreachable(val.kind) + + of conArray: + # --> {..., ..., ...} + startArrayInitializer(ast, sub.len.uint) + for _ in 0.. i + # each field must have an initializer expression when using a braced + # initializer - use a default value if none is specified by `data` + genDefaultVal(ast, c, id) + +func genBracedObjConstrPos(ast: var CAstBuilder, c: var GenCtx, id: TypeId, data: LiteralData, iter: var ArrayIter) = + ## Generates the braced initializer for an object based using positional + ## construction (``nkTupleConstr``) + let + base = c.env.types.base(id) + len = c.env.types.numFields(id) + + #assert c.env.types.numFields(id) + start == len + ast.add(cnkBraced, uint32(len + ord(base != NoneType))).void() + + # first consume the base type's fields + if base != NoneType: + genBracedObjConstrPos(ast, c, base, data, iter) + + let rIter = c.env.types.initRecordIter(id) + for i in 0.. skip it + continue + + case n.kind + of ntkSym: + let sId = irs.sym(n) + let sym = c.env.syms[sId] + # TODO: refactor + case sym.kind + of skVar, skLet, skForVar: + c.m.syms.incl sId + of skConst: + scanDeps(c.env.data, c.env.syms.data(sId), c.m) + + c.m.syms.incl sId + else: + discard + + useType(c.m, sym.typ) + + names[i] = start().ident(c.gl.symIdents[toIndex(sId)]).fin() + + of ntkParam: + let name = c.gl.funcs[toIndex(c.sym)].args[n.paramIndex].name + names[i] = start().ident(name).fin() + + of ntkProc: + let prc = c.env.procs[n.procId] + useFunction(c.m, n.procId) + + names[i] = start().ident(c.gl.funcs[toIndex(n.procId)].ident).fin() + of ntkLocal: + names[i] = start().ident(c.localNames[irs.getLocalIdx(i)]).fin() + + of ntkCall: + case n.callKind + of ckBuiltin: + let name = genBuiltin(c, irs, n.builtin, i) + names[i] = name + of ckMagic: + names[i] = genMagic(c, irs, n.magic, i) + of ckNormal: + let callee = irs.at(n.callee) + block: + var res = start().add(cnkCall, n.argCount.uint32).add(names[n.callee]) + let isImported = callee.kind == ntkProc and + sfImportc in c.env.procs[callee.procId].flags and + c.env.procs[callee.procId].decl.omit + + # XXX: this ``isImported`` hack makes sure that calls to + # ``posix.pipe`` compile for now + if not isImported: + genArgs(res, c, irs, i) + else: + genArgsImported(res, c, irs, i) + + names[i] = res.fin() + + if c.exprs[i].rc == 0: + assert c.exprs[i].hasSideEffect + result.add names[i] + names[i].reset() + inc numStmts + + # XXX: for instructions with ``rc == 0``, ``disjoint`` is always true + # (due to how it's computed), which would cause the logic below + # to try and emit a temporary. We short-circuit the logic for + # now, but a cleaner solution is needed. + continue + + of ntkAddr: + names[i] = start().emitAddr().add(names[n.addrLoc]).fin() + of ntkDeref: + names[i] = start().emitDeref().add(names[n.addrLoc]).fin() + of ntkAsgn: + testNode names[n.srcLoc].len > 0, i + result.add start().add(cnkInfix).add(names[n.wrLoc]).op(copAsgn).add(names[n.srcLoc]).fin() + inc numStmts + of ntkPathObj: + let + typId = types[n.srcLoc] + typ = c.env.types[typId] + (fieldId, steps) = c.env.types.findField(typId, n.fieldIdx) + field = c.env.types.field(fieldId.toIndex) + let src = names[n.srcLoc] + var ast = start() + + # `steps` is the relative depth in the type's hierarchy at which the + # field is located. E.g. `steps = 0` means it's in `typ`, `steps = 1` + # means it's in the base-type, etc. + for i in 0..steps: + discard ast.add(cnkDotExpr) + + discard ast.add(src) + + for i in 0.. 0 + + names[i] = start().accessSuper(depth, names[n.srcLoc], c.gl.idents.getOrIncl(BaseName)).fin() + else: + # both a conversion and a cast map to the same syntax here. Conversions + # not expressable in C were already transformed into either a ``memcpy`` + # or union at the IR level + names[i] = start().add(cnkCast).add(cnkType, mapTypeV2(c, n.typ).uint32).add(names[n.srcLoc]).fin() + + of ntkLit: + names[i] = genLit(c, irs.getLit(n)) + of ntkUse: + names[i] = names[n.srcLoc] + of ntkLocEnd: + # do nothing; we can't communicate to the C compiler that the + # referenced local isn't used anymore in the currrent control-flow path + discard + + of ntkBranch: + result.add cnkIf + result.add names[n.cond] + result.add cnkStmtList, 1 + result.add cnkGoto, c.gl.idents.getOrIncl(fmt"label{n.target}").uint32 + + # XXX: doesn't work due to how a `x or y` is represented in the IR + #[ + genStmtList(result, c, irs, n.target, pos) + + # skip the join coming after the branch's section + testNode irs.at(pos).kind == ntkJoin, pos + inc pos + ]# + + inc numStmts + of ntkJoin: + # always create a label, even for loops + # XXX: loops should use 'while' loops in the generated code instead + result.add cnkLabel, c.gl.idents.getOrIncl(fmt"label{n.joinPoint}").uint32 + inc numStmts + of ntkGoto: + result.add cnkGoto, c.gl.idents.getOrIncl(fmt"label{n.target}").uint32 + inc numStmts + + #[ + # a goto always marks the end of a section + break + ]# + + of ntkContinue, ntkGotoLink: + # both are required to be lowered earlier + unreachable(n.kind) + + else: + names[i] = genError(c, fmt"missing impl: {n.kind}") + if c.exprs[i].rc == 0: + # make sure the error is present in the generated code by emitting it + # as a statement + result.add names[i] + inc numStmts + + if n.kind notin Stmts and needsTemp(c.exprs[i]) and + c.exprs[i].hasSideEffect: + testNode(not isEmptyType(c.env.types, c.types[i]), i) + + let ident = c.gl.idents.getOrIncl(fmt"_cr{i}") + result.add cnkDef, 1 + result.add cnkType, c.types[i].uint32 + result.add cnkIdent, ident.uint32 + result.add names[i] + + names[i] = start().ident(ident).fin() + inc numStmts + +proc emitCDecl(f: File, c: GlobalGenCtx, decl: CDecl) + +proc emitType(f: File, c: GlobalGenCtx, t: CTypeId) = + let info {.cursor.} = c.ctypes[t.int] + if info.name != InvalidCIdent: + f.write c.idents[info.name] + else: + # the declaration is emitted directly if a type has no name + emitCDecl(f, c, info.decl) + +# XXX: since strings are now stored as part of `LiteralData`, we need access +# to it during emitting. To shorten the signatures a bit, it might make +# sense to store the `LiteralData` object as part of `GlobalGenCtx`. +# That would more or less require splitting `LiteralData` out of +# ``IrEnv`` - but that's probably a good idea anyway. +proc emitCAst(f: File, c: GlobalGenCtx, data: LiteralData, ast: CAst, pos: var int) + +proc emitAndEscapeIf(f: File, c: GlobalGenCtx, data: LiteralData, ast: CAst, pos: var int, notSet: set[CAstNodeKind]) = + if ast[pos].kind in notSet: + emitCAst(f, c, data, ast, pos) + else: + f.write "(" + emitCAst(f, c, data, ast, pos) + f.write ")" + +proc writeChars[I: static int](f: File, arr: array[I, char]) {.inline.} = + discard f.writeBuffer(unsafeAddr(arr), I) + +func formatCChar(a: var array[4, char], ch: char): range[1..4] {.inline.} = + ## Escapes the character with value `ch`, if necessary, and writes the + ## result to `a`. Returns the length of the resulting string + case ch + of '\x00'..'\x1F', '\x7F'..'\xFF': + a[0] = '\\' + # clang doesn't accept strings like "\x000" and complains with the + # message "hex escape sequence out of range". So instead, we use octal + # escape sequences + formatOctChar(a, 1, ord(ch).uint8) + 4 + of '\\', '\'', '\"': + a[0] = '\\' + a[1] = ch + 2 + else: + a[0] = ch + 1 + +proc emitCAst(f: File, c: GlobalGenCtx, data: LiteralData, ast: CAst, pos: var int) = + if pos >= ast.len: + for it in ast: + echo it + + template emitSub() = + emitCAst(f, c, data, ast, pos) + + template emitSub(s: set[CAstNodeKind]) = + emitAndEscapeIf(f, c, data, ast, pos, s) + + let n = ast[pos] + inc pos + + case n.kind + of cnkError: + f.write "GEN_ERROR(\"" + f.write c.strings[n.a.LitId] + f.write "\")" + of cnkStmtList: + for _ in 0.. 0: + f.write ", " + + emitSub() + + f.write ")" + + of cnkIf: + f.write "if (" + emitSub() # condition + f.writeLine ") {" + emitSub() # stmt list + f.write "}" + + of cnkWhile: + f.write "while (" + emitSub() # condition + f.write ") {" + emitSub() # stmt list + f.write "}" + + of cnkReturn: + f.write "return " + if n.a == 1: + emitSub() + + of cnkLabel: + f.write c.idents[n.a.LitId] + f.writeLine ":" + of cnkGoto: + f.write "goto " + f.write c.idents[n.a.LitId] + of cnkDotExpr: + emitSub({cnkIdent, cnkCall, cnkDotExpr}) + f.write "." + emitSub() + of cnkCharLit: + var arr = ['\'', '\\', 'x', '0', '0', '\''] + formatHexChar(arr, 3, n.a.uint8) + + f.writeChars arr + of cnkStrLit: + f.write '"' + let str = data.getStr(n.a.LiteralId) + # XXX: escape the string prior to adding it to ``c.strings``? + for ch in str.items: + var arr: array[4, char] + let len = formatCChar(arr, ch) + discard f.writeBuffer(unsafeAddr arr, len) + + f.write '"' + + of cnkIntLit: + f.write (n.a.uint64 shl 32) or n.b.uint64 + + of cnkFloat32Lit: + f.write toStrMaxPrecision(cast[float32](n.a)) + of cnkFloat64Lit: + f.write toStrMaxPrecision(cast[float64]((n.a.uint64 shl 32) or n.b.uint64)) + + of cnkType: + emitType(f, c, n.a.CTypeId) + + of cnkCast: + f.write "(" + emitSub() + f.write ") " + emitSub({cnkIdent}) + + of cnkOpToken: + f.write COpToStr[COperator(n.a)] + + of cnkBraced: + f.write "{" + for i in 0.. 0: + f.write ", " + emitSub() + f.write "}" + + of cnkTernary: + f.write "(" + emitSub() # condition + f.write ") ? " + emitSub({cnkIdent}) # a + f.write " : " + emitSub({cnkIdent}) # b + + else: + f.write "EMIT_ERROR(\"missing " & $n.kind & "\")" + +proc emitCAst(f: File, c: GlobalGenCtx, data: LiteralData, ast: CAst) = + var pos = 0 + while pos < ast.len: + emitCAst(f, c, data, ast, pos) + + +proc emitCDecl(f: File, c: GlobalGenCtx, decl: CDecl, pos: var int) + +proc emitFuncDecl(f: File, c: GlobalGenCtx, decl: CDecl, ident: CIdent, L: int, pos: var int) = + emitCDecl(f, c, decl, pos) # return type + if ident != InvalidCIdent: + f.write "(*" + f.write c.idents[ident] + f.write ")(" + else: + f.write "(*)(" + for i in 0.. 0: + f.write ", " + + emitCDecl(f, c, decl, pos) + + f.write ")" + +proc emitCDecl(f: File, c: GlobalGenCtx, decl: CDecl, pos: var int) = + if pos >= decl.len: + for it in decl: + echo it + let n = decl[pos] + inc pos + + case n.kind + of cdnkStruct, cdnkUnion: + f.write: + if n.kind == cdnkStruct: "struct " + else: "union " + + emitCDecl(f, c, decl, pos) + f.writeLine "{" + for _ in 0.. 0, c.idents[info.name] + + let kind = info.decl[0].kind + case kind + of cdnkStruct, cdnkUnion: + if isFwd: + # --> ``typdef struct X X;`` + # forward-declare the record type and make the identifier available in + # the ordinary namespace + f.write "typedef " + f.write: + case kind + of cdnkStruct: "struct" + of cdnkUnion: "union" + else: unreachable() + + f.write fmt" {c.idents[info.name]}" + f.write fmt" {c.idents[info.name]}" + pos = info.decl.len # mark the body as processed + else: + # definition requested + emitCDecl(f, c, info.decl, pos) + + of cdnkBracket: + f.write "typedef " + pos = 1 + emitCDecl(f, c, info.decl, pos) + f.write " " + f.write c.idents[info.name] + f.write "[" + emitCDecl(f, c, info.decl, pos) # the array size + f.write "]" + of cdnkFuncPtr: + f.write "typedef " + pos = 1 + emitFuncDecl(f, c, info.decl, info.name, info.decl[0].a.int, pos) + else: + f.write "typedef " + emitCDecl(f, c, info.decl, pos) + f.write " " + f.write c.idents[info.name] + + f.writeLine ";" + + assert pos == info.decl.len + +proc emitConst(f: File, ctx: GlobalGenCtx, data: LiteralData, syms: SymbolEnv, id: SymId, marker: var PackedSet[SymId]) = + ## Emits the definition for the constant named by `id` and remembers it in + ## `marker`. If the constant is already present in `marker`, nothing is + ## emitted. + ## If the constant's intializer references other constants, those are + ## emitted first + if marker.containsOrIncl(id): + return + + # recursively emit the constant's dependencies first + for dep in ctx.constDeps[id].items: + emitConst(f, ctx, data, syms, dep, marker) + + f.write "static const " + emitType(f, ctx, syms[id].typ) + f.write " " + f.write ctx.idents[ctx.symIdents[id.toIndex]] + f.write " = " + emitCAst(f, ctx, data, ctx.constInit[id]) + f.writeLine ";" + +proc writeProcHeader(f: File, c: GlobalGenCtx, h: CProcHeader, decl: DeclarationV2, withParamNames: bool): bool = + if decl.omit: + return false + + emitType(f, c, h.returnType) + f.write(" ") + f.write(c.idents[h.ident]) + f.write("(") + for i, it in h.args.pairs: + if i > 0: + f.write ", " + + emitType(f, c, it.typ) + + if withParamNames: + f.write " " + f.write c.idents[it.name] + + f.write ")" + result = true + +iterator pairs[T](x: PackedSet[T]): (int, T) = + var i = 0 + for it in x.items: + yield (i, it) + inc i + +func initGlobalContext*(c: var GlobalGenCtx, env: IrEnv) = + ## Initializes the ``GlobalGenCtx`` to use for all following + ## ``emitModuleToFile`` calls. Creates the ``CTypeInfo`` for each IR type. + + # TODO: use ``setLen`` + [] + for id in env.syms.items: + c.symIdents.add c.idents.getOrIncl(mangledName(env.syms[id].decl, id.uint32)) + + block: + # setup the field -> identifier map: + c.fieldIdents.newSeq(env.types.totalFields) + + # we setup the identifiers for named fields here instead of in + # ``genRecordNode`` (as is done for anonymous fields). Why? Because + # no ``CDecl`` is generated for ``.nodecl`` object types, but their fields + # still need identifiers. + for i, f in env.types.allFields: + # anonymous fields (used by tuples) use a position-based naming scheme, + # but since we don't know about field positions here, we defer identifier + # creation for those to ``genRecordNode`` + if f.sym != NoneDecl: + c.fieldIdents[i] = c.idents.getOrIncl(mangledName(env.syms[f.sym])) + + var gen = TypeGenCtx(weakTypes: {tnkRecord}, env: unsafeAddr env) + swap(gen.cache, c.idents) + swap(gen.fieldIdents, c.fieldIdents) + + # XXX: a leftover from the CTypeId -> TypeId transition. Needs to be removed + c.ctypes.add(CTypeInfo(name: gen.cache.getOrIncl("void"))) # the `VoidCType` + + # TODO: use ``setLen`` + [] + for id in types(env.types): + c.ctypes.add genCTypeInfo(gen, env.types, id) + + # TODO: rewrite the type translation logic here; it's inefficient + for id, target in env.types.proxies: + # don't redirect types that have an interface (i.e. are imported) + if env.types.iface(id) == nil: + # replace with an alias + c.ctypes[id.int].decl = @[(cdnkType, target.uint32, 0'u32)] + + swap(gen.cache, c.idents) + swap(gen.fieldIdents, c.fieldIdents) + + # create the procedure headers + # TODO: use ``setLen`` + [] + for id in env.procs.items: + c.funcs.add genCProcHeader(c.idents, env.procs, id) + + block: + # a constant needs to emitted in each module that references it. Instead + # of re-generating the ``CAst`` for each module the constant is used in, + # we create the initializer expression for all constants only once at the + # start. + # In this case, constant refers to *complex* constants (arrays, records, + # etc.) not simple ones (ints, floats, etc.). The latter were already + # inlined in ``transf`` + # XXX: it's very bad that we need a full ``GenCtx`` here. Some + # split-ups/reorderings are needed + var ctx = GenCtx(env: unsafeAddr env) + swap(ctx.gl, c) + + # iterate the items in reverse so that the initializer AST for all + # dependencies is generated before their dependees. Constants can + # only reference other constants with a higher ID + for id in env.syms.ritems: + let sym = env.syms[id] + if sym.kind == skConst: + let lit = env.syms.data(id) + # note: `c` is swapped with `ctx.gl` + ctx.gl.constInit[id] = start().genInitializerExpr(ctx, env.data, lit, sym.typ).fin() + + if lit.kind == lkComplex: + # collect the dependencies on other constants for the constant and + # store the result in a lookup-table for later + # XXX: the pre-calculated dependency list is only used for emitting + # constant definitions in the right order, but there's a better + # solution for the ordering problem. + # Due to how constants are generated and later transformed, the + # following is true: + # for constants 'a' and 'b', if `a.id < b.id`, then 'b' + # *cannot* depend on 'a' + # + # Emitting the used constants for a module in descending ID + # order would thus be enough to ensure correct definition order. + # ``PackedSet`` doesn't support iterating over it's items in + # that order however - ``TBitSet`` probably needs to be used + # instead + scanDeps(env.data, lit, ctx.m) + + var deps = newSeq[SymId](ctx.m.syms.len) + for i, it in ctx.m.syms.pairs: + deps[i] = it + + ctx.gl.constDeps[id] = move deps + + # prepare for the next constant: + ctx.m.syms.clear() + ctx.m.funcs.clear() + else: + # non-complex constants don't have dependencies + ctx.gl.constDeps[id] = @[] + + swap(ctx.gl, c) + +proc emitModuleToFile*(conf: ConfigRef, filename: AbsoluteFile, ctx: var GlobalGenCtx, env: IrEnv, + impls: openArray[IrStore3], m: ModuleData) = + let f = open(filename.string, fmWrite) + defer: f.close() + + #echo "Here: ", filename.string + + var + mCtx: ModuleCtx + asts: seq[CAst] + + mCtx.headers.incl("\"nimbase.h\"") + + for sym in m.procs.items: + let irs = impls[sym.toIndex] + useFunction(mCtx, sym) + + if sfImportc in env.procs[sym].flags: + asts.add(default(CAst)) + continue + + #echo "genFor: ", env.procs[sym].decl.name.s #, " at ", conf.toFileLineCol(sym.info) + var c = GenCtx(config: conf, sym: sym, env: unsafeAddr env) + # doing a separate pass for the type computation instead of doing it in + # `genCode` is probably a bit less efficient, but it's also simpler; + # requires less code duplication; and is also good for modularity + c.types = computeTypes(irs, env) + + swap(c.gl, ctx) + swap(c.m, mCtx) + asts.add genCode(c, irs) + swap(c.m, mCtx) + swap(c.gl, ctx) + + # mark the types used in procedure signatures as used + for id in mCtx.funcs.items: + mCtx.useType(env.procs.getReturnType(id)) + + for it in env.procs.params(id): + mCtx.useType(it.typ) + + for id in m.syms.items: + mCtx.useType(env.syms[id].typ) + + # mark the type of used globals and constants as used and collect C-header + # dependencies + for id in mCtx.syms.items: + # TODO: is it necessary to mark the type as used if the sym is + # ``.nodecl``? + # XXX: the ``useType`` here is redundant - already happened when the + # symbol was added to the set + mCtx.useType(env.syms[id].typ) + if (let iface = env.syms.iface(id); iface != nil): + if lfHeader in iface.loc.flags: + mCtx.headers.incl getStr(iface.annex.path) + + # collect all types that need to be defined in this translation unit (.c file) + + type TypeDef = tuple[fwd: bool, id: CTypeId] + + func collectFwd(list: var seq[TypeDef], types: seq[CTypeInfo], id: CTypeId, marker, markerFwd: var PackedSet[CTypeId]) = + if id notin marker and not markerFwd.containsOrIncl(id): + # not defined nor forward declared + assert types[id.int].name != InvalidCIdent + list.add (true, id) + + func collectOrdered(list: var seq[TypeDef], types: seq[CTypeInfo], + id: CTypeId, marker, markerFwd: var PackedSet[CTypeId]) = + let info {.cursor.} = types[id.int] + if marker.containsOrIncl(id): + # nothing to do + return + + if info.decl.len > 0 and info.decl[0].kind in {cdnkStruct, cdnkUnion}: + # a forward ``typedef`` is used for all structs and unions for two reasons: + # * the typedef introduces the identifier in the ordinary name-space + # * it's a simple solution to the cyclical object type problem + list.add (true, id) + markerFwd.incl id + + # scan the type's body for dependencies and add them first + for n in info.decl.items: + case n.kind + of cdnkType: + # requires a definition + collectOrdered(list, types, n.a.CTypeId, marker, markerFwd) + of cdnkWeakType: + # only requires a forward declaration + collectFwd(list, types, n.a.CTypeId, marker, markerFwd) + else: + discard + + # XXX: the used headers could also be collected here, but that would grow + # the required state even more + + if info.name != InvalidCIdent: + # only collect types that have an identifier. The others don't need a + # typedef (they're inlined directly) and also don't/can't have header + # dependency information attached + list.add (false, id) + + var typedefs: seq[TypeDef] + var marker, markerFwd: PackedSet[CTypeId] + for it in mCtx.types.items: + collectOrdered(typedefs, ctx.ctypes, it, marker, markerFwd) + + marker.reset() # no longer needed + + # collect the header dependencies from the used types + # XXX: to be more efficient, writing out the header includes for the types + # could be combined with emitting the type definitions + for _, id in typedefs.items: + let iface = env.types.iface(id) + if iface != nil and lfHeader in iface.loc.flags: + mCtx.headers.incl getStr(iface.annex.path) + + # collect the header dependencies of used functions + for id in mCtx.funcs.items: + let header = env.procs[id].iface.header + if header.len != 0: + mCtx.headers.incl header + + # ----- start of the emit logic ----- + + f.writeLine "#define NIM_INTBITS 64" # TODO: don't hardcode + + # headers + for h in mCtx.headers.items: + # the provided header string is allowed to not have the extra include + # syntax: + if h[0] in {'<', '"'}: + f.write "#include " + f.writeLine h + else: + # no '"' or '<' is present -> wrap the string in a '"' pair + f.write "#include \"" + f.write h + f.writeLine "\"" + + # undefine some macros defined by either the C-compiler or by some included + # headers that could otherwise clash with identifiers were emitting + f.write """#undef LANGUAGE_C +#undef MIPSEB +#undef MIPSEL +#undef PPC +#undef R3000 +#undef R4000 +#undef i386 +#undef linux +#undef mips +#undef near +#undef far +#undef powerpc +#undef unix +""" + + # type section + + for fwd, id in typedefs.items: + let info = ctx.ctypes[id.int] + # imported types don't have a body + if info.decl.len > 0: + emitCType(f, ctx, ctx.ctypes[id.int], isFwd=fwd) + + # emit prototypes for all used functions + for id in mCtx.funcs.items: + #echo "decl: ", sym.name.s, " at ", conf.toFileLineCol(sym.info) + if writeProcHeader(f, ctx, ctx.funcs[id.toIndex], env.procs[id].decl, false): + f.writeLine ";" + + # globals of the current module + for id in m.syms.items: + let sym = env.syms[id] + if sym.decl.omit: + continue + + case sym.kind + of skLet, skVar, skForVar: + emitType(f, ctx, sym.typ) + f.write " " + f.write ctx.idents[ctx.symIdents[toIndex(id)]] + f.writeLine ";" + else: + unreachable(sym.kind) + + # referenced globals + for id in mCtx.syms.items: + let sym = env.syms[id] + let ident = ctx.symIdents[toIndex(id)] + + if sym.decl.omit: + continue + + case sym.kind + of skLet, skVar, skForVar: + # XXX: the `mCtx.syms` set might also include globals that are *defined* + # as part of this module - in which case the declaration here is + # redundant + f.write "extern " + emitType(f, ctx, sym.typ) + f.write " " + f.write ctx.idents[ident] + f.writeLine ";" + of skConst: + discard "processed later" + else: + unreachable(sym.kind) + + block: + # emit all used constants + var symMarker: PackedSet[SymId] + for id in mCtx.syms.items: + let s = env.syms[id] + + if not s.decl.omit and s.kind == skConst: + emitConst(f, ctx, env.data, env.syms, id, symMarker) + + var i = 0 + for it in asts.items: + if it.len == 0: + inc i + continue + + let + id = m.procs[i] + prc = env.procs[id] + + if writeProcHeader(f, ctx, ctx.funcs[id.toIndex], prc.decl, true): + # only emit the body if the procedure is not omitted (i.e. declared + # as `.noDecl`) + # XXX: forbid using the .noDecl pragma on a procedure with body? + f.writeLine "{" + emitCAst(f, ctx, env.data, it) + f.writeLine "}" + + inc i \ No newline at end of file diff --git a/compiler/vm/cpasses.nim b/compiler/vm/cpasses.nim new file mode 100644 index 00000000000..de36891b350 --- /dev/null +++ b/compiler/vm/cpasses.nim @@ -0,0 +1,770 @@ +## IR passes that are meant for the C-family targets. + +# XXX: what passes are located here is for the most part arbitrary at the +# moment + +import + std/[ + tables + ], + compiler/ast/[ + ast, + idents + ], + compiler/vm/[ + irpasses, + pass_helpers, + vmir + ] + +from compiler/vm/vmdef import unreachable + +func transformNrvo*(g: PassEnv, procs: var ProcedureEnv) = + ## Performs the named-return-value-optimization (NRVO) + discard + +type CTransformEnv* = object + ## State and artifacts for/of type transformation; not modified during + ## procedure transformation + rawProcs: Table[TypeId, TypeId] ## for each closure type the procedure type + ## without the environment parameter + remap: Table[TypeId, TypeId] + +type CTransformCtx* {.requiresInit.} = object + graph*: PassEnv + transEnv*: ptr CTransformEnv + + +func wrapNot(cr: var IrCursor, g: PassEnv, val: IRIndex): IRIndex = + cr.insertCallExpr(mNot, g.sysTypes[tyBool], val) + +const IntLikeTypes = {tnkBool, tnkChar, tnkInt, tnkUInt} + +func insertReset(cr: var IrCursor, g: PassEnv, env: var IrEnv, typ: TypeId, target: IRIndex) = + ## Inserts a low-level reset. Depending on the target type, this is either + ## an assignment or a call to ``nimZeroMem`` + # XXX: a mutable `env` is too broad. Only literal data is mutated here + case env.types[typ].kind + of IntLikeTypes: + cr.insertAsgn(askShallow, target, cr.insertLit(env.data, 0)) + of tnkFloat: + cr.insertAsgn(askShallow, target, cr.insertLit(env.data, 0.0)) + of tnkPtr, tnkRef: + cr.insertAsgn(askShallow, target, cr.insertNilLit(env.data, typ)) + else: + # TODO: handle the case where `target` is a ``var`` type + cr.insertCompProcCall(g, "nimZeroMem", cr.insertAddr(target), cr.insertMagicCall(g, mSizeOf, tyInt, cr.insertTypeLit(typ))) + +func visit(ir: IrStore3, types: TypeContext, env: var IrEnv, c: CTransformCtx, cr: var IrCursor) = + template arg(i: Natural): IRIndex = + ir.args(cr.position, i) + + let n = ir[cr] + case n.kind + of ntkCall: + case n.callKind + of ckBuiltin: + case n.builtin + of bcRaise: + cr.replace() + # XXX: cache the compiler procs + if argCount(n) == 0: + # re-raise + cr.insertCompProcCall(c.graph, "reraiseException") + else: + assert argCount(n) == 2 + let typ = env.types.lookupGenericType(tnkRef, c.graph.getCompilerType("Exception")) + let nilLit = cr.insertNilLit(env.data, typ) + cr.insertCompProcCall(c.graph, "raiseExceptionEx", + arg(0), arg(1), nilLit, nilLit, cr.insertLit(env.data, 0)) + + of bcExitRaise: + cr.replace() + cr.insertCompProcCall(c.graph, "popCurrentException") + + of bcOverflowCheck: + let + orig = ir.at(arg(0)) + lhs = ir.args(arg(0), 0) + rhs = ir.args(arg(0), 1) + + let m = getMagic(ir, env, orig) + assert m in mAddI..mPred + + const + prc: array[mAddI..mPred, string] = [ + "nimAddInt", "nimSubInt", + "nimMulInt", "nimDivInt", "nimModInt", + "nimAddInt", "nimSubInt" + ] + prc64: array[mAddI..mPred, string] = [ + "nimAddInt64", "nimSubInt64", + "nimMulInt64", "nimDivInt64", "nimModInt64", + "nimAddInt64", "nimSubInt64" + ] + + func is64bit(t: Type): bool {.inline.} = + t.kind == tnkInt and t.size == 0 + + let name = if is64bit(env.types[types[lhs]]): prc64[m] else: prc[m] + + cr.replace() + + # perform the div-by-zero test first + if m in {mDivI, mModI}: + cr.genIfNot(cr.wrapNot(c.graph, cr.insertMagicCall(c.graph, mEqI, tyBool, rhs, cr.insertLit(env.data, 0)))): + cr.insertCompProcCall(c.graph, "raiseDivByZero") + + let tmp = cr.newLocal(lkTemp, types[lhs]) + cr.genIfNot(cr.wrapNot(c.graph, cr.insertCompProcCall(c.graph, name, lhs, rhs, cr.insertAddr(cr.insertLocalRef(tmp))))): + cr.insertCompProcCall(c.graph, "raiseOverflow") + + discard cr.insertLocalRef(tmp) + + of bcInitLoc: + cr.replace() + cr.insertReset(c.graph, env, types[arg(0)], arg(0)) + + of bcStrToCStr: + cr.replace() + cr.insertCompProcCall(c.graph, "nimToCStringConv", arg(0)) + of bcCStrToStr: + cr.replace() + cr.insertCompProcCall(c.graph, "cstrToNimstr", arg(0)) + else: + discard + + of ckMagic: + let m = n.magic + case m + of mWasMoved: + cr.replace() + cr.insertReset(c.graph, env, types[arg(0)], arg(0)) + of mCharToStr..mInt64ToStr: + # XXX: the ``mInt64ToStr`` magic could be replaced with the usage + # of ``mIntToStr`` + const Prc = [mCharToStr: "nimCharToStr", mBoolToStr: "nimBoolToStr", + mIntToStr: "nimIntToStr", mInt64ToStr: "nimInt64ToStr"] + cr.replace() + cr.insertCompProcCall(c.graph, Prc[m], arg(0)) + of mFloatToStr: + let prc = + if env.types.getSize(types[arg(0)]) == 32: + "nimFloat32ToStr" + else: + "nimFloatToStr" + + cr.replace() + cr.insertCompProcCall(c.graph, prc, arg(0)) + of mCStrToStr: + cr.replace() + cr.insertCompProcCall(c.graph, "cstrToNimstr", arg(0)) + of mAccessTypeField: + # replace with accessing the field at position '-1' (the type field) + cr.replace() + + let src = + case env.types[types[arg(0)]].kind + of tnkRef, tnkPtr, tnkVar, tnkLent: + cr.insertDeref(arg(0)) + of tnkRecord: + arg(0) + else: + unreachable() + + discard cr.insertPathObj(src, -1) + of mLtStr, mLeStr: + # ---> + # cmpStrings(a, b) (< | <=) 0 + cr.replace() + let + val = cr.insertCompProcCall(c.graph, "cmpStrings", arg(0), arg(1)) + prc = (if m == mLtStr: mLtI else: mLeI) + + cr.insertMagicCall(c.graph, prc, tyInt, val, cr.insertLit(env.data, 0)) + + of mLengthStr: + # must be the ``len`` operator for a cstring. The one for normal + # strings was already lowered earlier + # ---> + # var tmp: int + # if str != nil: + # tmp = nimCStrLen(str) + # else: + # tmp = 0 + # tmp + let str = arg(0) + assert env.types.kind(types[str]) == tnkCString + cr.replace() + + let + elsePart = cr.newJoinPoint() + exit = cr.newJoinPoint() + tmp = cr.newLocal(lkTemp, c.graph.sysTypes[tyInt]) + tmpAcc = cr.insertLocalRef(tmp) + + cr.insertBranch(cr.insertMagicCall(c.graph, mIsNil, tyBool, str), elsePart) + cr.insertAsgn(askInit, tmpAcc, cr.insertCompProcCall(c.graph, "nimCStrLen", str)) + cr.insertGoto(exit) + + cr.insertJoin(elsePart) + cr.insertAsgn(askInit, tmpAcc, cr.insertLit(env.data, 0)) + cr.insertGoto(exit) + + cr.insertJoin(exit) + + discard cr.insertLocalRef(tmp) + + of mParseBiggestFloat: + # problem: ``parseBiggestFloat`` is a magic procedure that imports + # (via importc) a ``.compilerproc`` (``nimParseBiggestFloat``). + # The new back-end doesn't support this kind of indirect + # dependency, but there already exists a solution: the + # ``.importCompilerProc`` pragma, which is already supported + # by ``irgen``. The problem with the pragma: ``cgen`` doesn't + # properly support it (neither does ``jsgen``), so using it on + # ``parseBiggestFloat`` breaks bootstrapping. + # **EDIT**: ``.importCompilerProc`` would only work if it's + # conditionally applied depending on the used target language + # XXX: fix the issue with ``cgen`` and use the ``importCompilerProc`` + # pragma instead of working around the issue here + cr.replace() + cr.insertCompProcCall(c.graph, "nimParseBiggestFloat", arg(0), arg(1), arg(2)) + + else: + discard + + of ckNormal: + discard + + of ntkCast: + # TODO: needs to be revisited for compatibility with ``cgen`` + + const PtrLike = {tnkPtr, tnkRef, tnkProc, tnkCString} + + var useBlit = false + case env.types.kind(n.typ): + of PtrLike, tnkInt, tnkUInt, tnkBool, tnkChar: + let srcTyp = env.types.kind(types[n.srcLoc]) + case srcTyp + of tnkInt, tnkUInt, tnkBool, tnkChar, PtrLike: + useBlit = false + else: + # TODO: we need to work around the type of an ``addr x`` expression + # being wrong (see ``computeTypes``). Remove the test here once + # the type of 'addr' expressions is computed correctly + useBlit = ir.at(n.srcLoc).kind != ntkAddr + else: + useBlit = true + + if useBlit: + # for the C-family targets, a value-type cast is implemented as a + # ``memcpy``. Compared to the type-punning-via-union approach, this is + # correct even when strict-aliasing is enabled + + cr.replace() + let + tmp = cr.newLocal(lkTemp, n.typ) + tmpAcc = cr.insertLocalRef(tmp) + + when true: + # TODO: ``cgen2`` currently doesn't respect the IR's semantics (i.e. + # each node represents an lvalue) and thus generates faulty code + # if the src expression doesn't represent an lvalue expression in + # the C code. + # We work around that here by introducing a temporary - but this + # should be removed once ``cgen2`` works properly + # XXX: allowing non-lvalues to be implicitly promoted to lvalues (by + # introducing a temporary) doesn't sound so good anymore. The + # explicit temporary approach we're using here is probably better. + # To not unnecessarily introduce a temporary (in the case that + # the source operand is an lvalue), we could either only look at + # the source operand's node kind or introduce an analysis pre-pass + # that computes the category of each value + let rhs = cr.insertLocalRef(cr.newLocal(lkTemp, types[n.srcLoc])) + cr.insertAsgn(askInit, rhs, n.srcLoc) + + # XXX: casting from smaller to larger types will access invalid memory + # SPEC: the exact behaviour when casting between types of different size + # is not specified + # XXX: what to do if one of the types' size is not known (e.g. if it's an + # imported type)? + cr.insertCompProcCall(c.graph, "nimCopyMem", cr.insertAddr(tmpAcc), cr.insertAddr(rhs), cr.insertMagicCall(c.graph, mSizeOf, tyInt, cr.insertTypeLit(n.typ))) + + discard cr.insertLocalRef(tmp) + + of ntkConv: + # we need to guard against closures since that conversion is handled + # separately by the closure lowering pass + if env.types.kind(n.typ) != tnkClosure and + env.types.resolve(n.typ) == env.types.resolve(types[n.srcLoc]): + # conversion to itself. This happens for conversion between distinct + # types and their base or when previously different types become the + # same after lowering + + # XXX: maybe we need a way to distinguish between *value* conversions + # (i.e. yielding a value) and *lvalue* conversions (i.e. yielding + # an lvalue with the same identity but different type as the source + # operand) + + # note: do not introduce a temporary here. If the conversion is an lvalue + # conversion, the result must have the same identity as the input + cr.redirect(n.srcLoc) + + else: + discard + +const + ClosureProcField = 0 + ClosureEnvField = 1 + +func lowerClosuresVisit(ir: IrStore3, types: TypeContext, env: var IrEnv, c: CTransformCtx, cr: var IrCursor) = + let n = ir[cr] + case n.kind + of ntkAsgn: + if env.types[types[n.wrLoc]].kind == tnkClosure: + case n.asgnKind + of askCopy: + # an earlier pass is responsible for lowering the environment + # assignment part + cr.replace() + cr.insertAsgn(askCopy, cr.insertPathObj(n.wrLoc, ClosureProcField), + cr.insertPathObj(n.srcLoc, ClosureProcField)) + + of askMove, askBlit: + # TODO: it's not clear yet what these two should do for closure + # objects + discard + + of ntkCall: + case n.callKind + of ckBuiltin: + case n.builtin + of bcNewClosure: + cr.replace() + let + tmp = cr.newLocal(lkTemp, n.typ) + tmpAcc = cr.insertLocalRef(tmp) + + cr.insertAsgn(askInit, cr.insertPathObj(tmpAcc, ClosureProcField), ir.argAt(cr, 0)) + cr.insertAsgn(askInit, cr.insertPathObj(tmpAcc, ClosureEnvField), ir.argAt(cr, 1)) + + discard cr.insertLocalRef(tmp) + else: + discard + + of ckMagic: + let m = n.magic + case m + of mIsNil: + let arg0 = ir.argAt(cr, 0) + if env.types[types[arg0]].kind == tnkClosure: + cr.replace() + discard cr.insertMagicCall(c.graph, mIsNil, tyBool, cr.insertPathObj(arg0, ClosureProcField)) + + of mEqProc: + let + arg0 = ir.argAt(cr, 0) + arg1 = ir.argAt(cr, 1) + + # only the equality operator for closures is lowered here - the one + # for non-closure procedures is translated in ``cgen2`` + if env.types[types[arg0]].kind == tnkClosure: + # ---> + # var tmp: bool + # if a.prc == b.prc: + # tmp = a.env == b.env + # tmp + cr.replace() + let + tmp = cr.newLocal(lkTemp, c.graph.sysTypes[tyBool]) + tmpAcc = cr.insertLocalRef(tmp) + exit = cr.newJoinPoint() + + cr.insertBranch(cr.insertMagicCall(c.graph, mNot, tyBool, cr.insertMagicCall(c.graph, mEqRef, tyBool, cr.insertPathObj(arg0, ClosureProcField), cr.insertPathObj(arg1, ClosureProcField))), exit) + cr.insertAsgn(askInit, tmpAcc, cr.insertMagicCall(c.graph, mEqRef, tyBool, cr.insertPathObj(arg0, ClosureEnvField), cr.insertPathObj(arg1, ClosureEnvField))) + + cr.insertJoin(exit) + discard cr.insertLocalRef(tmp) + + of mAccessEnv: + cr.replace() + discard cr.insertPathObj(ir.argAt(cr, 0), ClosureEnvField) + + else: + discard + + # rewrite calls using closures as the callee + elif ir.at(n.callee).kind != ntkProc and env.types[types[n.callee]].kind == tnkClosure: + # ---> + # if cl.env != nil: + # cl.prc(args, cl.env) + # else: + # cast[NonClosurePrcTyp](cl.prc)(args) + let cl = n.callee + + cr.replace() + + let cond = cr.insertMagicCall(c.graph, mIsNil, tyBool, cr.insertPathObj(cl, ClosureEnvField)) + let + elseP = cr.newJoinPoint() + endP = cr.newJoinPoint() + + let (tmp, tmpAcc) = + if env.types[types[cr.position]].kind == tnkVoid: + (0, InvalidIndex) + else: + let l = cr.newLocal(lkTemp, types[cr.position]) + (l, cr.insertLocalRef(l)) + + # XXX: meh, unnecessary allocation. The ``IrCursor`` API needs to + # expose low-level call generation. + var args = newSeq[IRIndex](n.argCount) + block: + var i = 0 + for arg in ir.args(cr.position): + args[i] = arg + inc i + + template asgnResult(val: IRIndex) = + let v = val + if tmpAcc != InvalidIndex: + cr.insertAsgn(askInit, tmpAcc, v) + + cr.insertBranch(cond, elseP) + block: + # "env is present"-branch + args.add cr.insertPathObj(cl, ClosureEnvField) + + asgnResult cr.insertCallExpr(cr.insertPathObj(cl, ClosureProcField), args) + cr.insertGoto(endP) + + cr.insertJoin(elseP) + block: + # the closure procedure needs to be cast to the non-closure + # counterpart first + let prc = cr.insertCast(c.transEnv.rawProcs[types[n.callee]], + cr.insertPathObj(cl, ClosureProcField)) + + # remove the env arg + args.del(args.high) + + asgnResult cr.insertCallExpr(prc, args) + cr.insertGoto(endP) + + cr.insertJoin(endP) + + if tmpAcc != InvalidIndex: + discard cr.insertLocalRef(tmp) + + of ntkConv: + if env.types[n.typ].kind == tnkClosure: + # ``sigmatch`` introduces a ``nkHiddenSubConv`` when assigning a + # procedural value of non-closure calling convention to a closure. It + # subsequently gets translated into a 'conv' by ``irgen`` and + # then reaches here. + # Since all procedural types using the ``ccClosure`` calling-convention + # are translated into ``tnkClosure`` (which renders the conversion wrong), + # we have to rewrite the conversion to use the correct type: + let prcTyp = env.types[env.types.nthField(c.transEnv.remap[n.typ], ClosureProcField)].typ + + cr.replace() + discard cr.insertCast(prcTyp, n.srcLoc) + + else: + discard + +func lowerEchoVisit(c: var UntypedPassCtx, n: IrNode3, ir: IrStore3, cr: var IrCursor) = + ## Doesn't need the IR to be typed + case n.kind + of ntkCall: + case getMagic(ir, c.env[], n) + of mEcho: + cr.replace() + + # construct an array from the arguments + let + arr = cr.newLocal(lkTemp, c.env.types.lookupArrayType(n.argCount.uint, c.graph.sysTypes[tyString])) + arrAcc = cr.insertLocalRef(arr) + + for i in 0.. + # var tmp = true + # if condA or condB or ...: + # tmp = false + # tmp + # + # for single items the condition is calculated via: + # val != elem + # + # for ranges, it's the following: + # val < range.a or range.b < val + + let + tmp = cr.newLocal(lkTemp, boolTy) + exit = cr.newJoinPoint() + + # TODO: add an ``insertLit`` overload that accepts a boolean + cr.insertAsgn(askInit, cr.insertLocalRef(tmp), cr.insertLit(data, 1)) # true + + case tk + of tnkInt, tnkUInt, tnkChar, tnkBool, tnkFloat: + let (eq, lt) = + case tk + of tnkInt: (mEqI, mLtI) + of tnkUInt: (mEqI, mLtU) + of tnkChar: (mEqCh, mLtCh) + of tnkBool: (mEqB, mEqB) + of tnkFloat: (mEqI, mLtF64) + else: + unreachable(tk) + + genSliceListMatch(val, eq, lt, data, ofBranch, typ, boolTy, exit, cr) + + of tnkString: + # TODO: implement the hash-table optimization employed by ``ccgstmts`` + genSliceListMatch(val, mEqStr, mLtStr, data, ofBranch, typ, boolTy, exit, cr) + + else: + unreachable(tk) + + cr.insertAsgn(askCopy, cr.insertLocalRef(tmp), cr.insertLit(data, 0)) # false + cr.insertJoin(exit) + + result = cr.insertLocalRef(tmp) + +const ctransformPass* = TypedPass[CTransformCtx](visit: visit) +const lowerClosuresPass* = TypedPass[CTransformCtx](visit: lowerClosuresVisit) +const lowerMatchPass* = TypedPass[PassEnv](visit: lowerMatch) +const lowerEchoPass* = LinearPass2[UntypedPassCtx](visit: lowerEchoVisit) + +func transformClosureProc*(g: PassEnv, paramName: PIdent, localName: DeclId, + id: ProcId, procs: var ProcedureEnv, + code: var IrStore3) = + ## If the procedure named by `id` has the calling convention ``ccClosure``, + ## adds an additional paramter with the name `paramName` used for passing + ## the closure's environment, and also lowers ``bcAccessEnv`` magic calls + ## present in the body (`code`). + ## `localName` is the name to use for the local storing the correctly typed + ## environment reference. + + # XXX: is it really necessary for the local to have a name? It only helps + # with reading the C code and doesn't serve any other purpose + + if procs[id].callConv == ccClosure: + # add the env param + procs.mget(id).params.add (paramName, g.sysTypes[tyPointer]) + + # only perform the transformation if the procedure really captures an + # environment - no ``bcAccessEnv`` is present otherwise + let envTyp = procs[id].envType + if envTyp != NoneType: + lowerAccessEnv(code, envTyp, localName, procs.numParams(id) - 1) + +func applyCTypeTransforms*(c: var CTransformEnv, g: PassEnv, env: var TypeEnv, senv: var SymbolEnv) = + # lower closures to a ``tuple[prc: proc, env: pointer]`` pair + let pointerType = g.sysTypes[tyPointer] + for id, typ in env.items: + if typ.kind == tnkClosure: + let prcTyp = env.requestProcType(id, ccNimCall, params=[pointerType]) + + c.remap[id] = env.requestRecordType(base = NoneType): + [(NoneDecl, prcTyp), + (NoneDecl, pointerType)] + + # needed for the lowering of closure invocations + c.rawProcs[id] = env.requestProcType(id, ccNimCall) + +func finish*(c: var CTransformEnv, env: var TypeEnv) = + ## Commit the type modifications + commit(env, c.remap) + +func transformContinue*(code: IrStore3, pe: PassEnv, data: var LiteralData, changes: var Changes) = + ## Transforms ``ntkGotoLink`` and ``ntkContinue`` into simple gotos. + # TODO: improved the documentation. Explain what a "linked section" is, how + # they're detected, and how the transformation works + var cr: IrCursor + cr.setup(code) + + type SecInfo = object + ## Information about a linked section + tmp: IRIndex ## the temporary used for remembering the "name" of the + ## previous section + items: seq[JoinPoint] ## possible targets for the continue + + var + sections: Table[JoinPoint, SecInfo] + stack: seq[JoinPoint] ## the stack of active linked sections. An item is + ## pushed when the entry point (i.e. ``ntkJoin``) of a linked section is + ## encountered, and popped when an ``ntkContinue`` is encountered + # XXX: use recursion instead? It would requires less heap allocations - + # but also make the code more complex + + # TODO: move `sections` and `stack` into an object of which an isntance is + # then passed to ``transformContinue`` in order to reuse the memory? + # I attempted this when building the compiler itself, and it brought a + # measurable (but very likely insignificant) performance improvement. + # ``finally`` is only very seldomly used in the compiler's code, so + # it's likely that the improvement will be much more pronounced with + # code-bases that make heavy use of ``finally`` + + # XXX: the ordering requirements of ``IrCursor`` (i.e. changes are recorded + # in ascending order) are violated here. The resulting changeset thus + # can't be merged via ``update``. + + for i, n in code.pairs: + case n.kind + of ntkGotoLink: + let sec = addr sections.mgetOrPut(n.target, default(SecInfo)) + let tmp = block: + # if `sec.items` is empty, the sections was just added to the table + if sec.items.len > 0: + sec.tmp + else: + sec.tmp = cr.insertLocalRef cr.newLocal(lkTemp, pe.sysTypes[tyInt]) + sec.tmp + + let join = cr.newJoinPoint() + cr.setPos(i) + cr.replace() + cr.insertAsgn(askCopy, tmp, cr.insertLit(data, sec.items.len)) + cr.insertGoto(n.target) + cr.insertJoin(join) + + # record the join point + sec.items.add(join) + + of ntkJoin: + if n.joinPoint in sections: + # the start of a linked sections + stack.add(n.joinPoint) + + of ntkContinue: + let + item = stack.pop() + sec = unsafeAddr sections[item] + + cr.setPos(i) + cr.replace() + + # generate the dispatcher logic + let tmp = sec.tmp + for i, it in sec.items.pairs: + let join = cr.newJoinPoint() + cr.insertBranch(wrapNot(cr, pe, cr.insertMagicCall(pe, mEqI, tyBool, tmp, cr.insertLit(data, i))), join) + cr.insertGoto(it) + + cr.insertJoin(join) + + # a ``ntkGotoLink`` must never be a jump backwards. We take advantage of + # this knowledge to reduce memory usage by removing the section's table + # entry once the ``ntkContinue`` (the end of the linked section) is + # encountered + sections.del(item) + + else: + discard + + assert stack.len == 0 + assert sections.len == 0 + + changes.merge(cr) diff --git a/compiler/vm/irdbg.nim b/compiler/vm/irdbg.nim new file mode 100644 index 00000000000..9880349839d --- /dev/null +++ b/compiler/vm/irdbg.nim @@ -0,0 +1,173 @@ +import compiler/vm/vmir + +import std/strformat +import std/options + +# TODO: not related to debugging, move proc somewhere else +func calcStmt*(irs: IrStore3): seq[bool] = + # XXX: very poor way of checking for statements + result.newSeq(irs.len) + var i = 0 + for n in irs.nodes: + case n.kind + of ntkSym, ntkLocal, ntkJoin, ntkLit, ntkGoto, ntkProc, ntkParam: + discard + of ntkCall: + for it in irs.args(i): + result[it] = true + + if n.callKind == ckNormal: + result[n.callee] = true + of ntkAddr, ntkDeref: + result[n.addrLoc] = true + of ntkAsgn: + result[n.wrLoc] = true + result[n.srcLoc] = true + of ntkPathObj: + result[n.srcLoc] = true + of ntkPathArr: + result[n.srcLoc] = true + result[n.arrIdx] = true + of ntkUse, ntkConv, ntkCast: + result[n.srcLoc] = true + of ntkBranch: + result[n.cond] = true + else: + debugEcho "Skipping: ", n.kind + inc i + +proc printTypes*(ir: IrStore3, e: IrEnv) = + var i = 0 + for (id, sid) in ir.locals: + var visited: seq[TypeId] + var indent = "" + echo "local ", i, ":" + var t = id + while t != NoneType and t notin visited: + visited.add t + echo indent, e.types[t] + indent &= " " + t = e.types[t].base + + inc i + +func typeName(e: TypeEnv, t: TypeId): string = + if (let iface = e.iface(t); iface != nil): + iface.name.s + else: + $e.kind(t) + +func typeToStr*(env: TypeEnv, id: TypeId): string = + var id = id + var d = 0 + while id != NoneType: + let t = env[id] + if (let iface = env.iface(id); iface != nil): + result.add iface.name.s + break + elif (let a = env.getAttachmentIndex(id); a.isSome): + result.add env.getAttachment(a.unsafeGet)[0].s + break + else: + inc d + result.add $env.kind(id) + result.add "[" + id = t.base + + for _ in 0.." + + if exprs.len == 0: + line = fmt"{i}(?): {line}" + elif exprs[i]: + line = fmt"{i}: {line}" + elif indentStmt: + line = " " & line + + yield line + inc i + +proc printIr*(irs: IrStore3, e: IrEnv, exprs: seq[bool]) = + for x in toStrIter(irs, e, exprs): + echo x + + +proc echoTrace*(ir: IrStore3, n: IRIndex) = + let trace = ir.traceFor(n) + for e in trace.items: + echo fmt"{e.filename}({e.line}, 1) {e.procname}" \ No newline at end of file diff --git a/compiler/vm/irgen.nim b/compiler/vm/irgen.nim new file mode 100644 index 00000000000..9a8a4b910c9 --- /dev/null +++ b/compiler/vm/irgen.nim @@ -0,0 +1,2256 @@ +## The module implements the tranlsation from semantically analysed and +## transformed NimSkull AST to the intermediate langauge used by the back-end + +# XXX: this module was based off of ``vmgen``. There's still a lot of VM +# related code present here that needs to be removed + +import + std/[ + packedsets, + tables, + strutils + ], + compiler/ast/[ + renderer, + types, + trees, + ast, + astalgo, + reports, + lineinfos + ], + compiler/modules/[ + magicsys, + modulegraphs + ], + compiler/front/[ + msgs, + options + ], + compiler/vm/[ + irliterals, + irtypes, + vmir + ], + experimental/[ + results + ] + +from compiler/vm/vmaux import findRecCase, findMatchingBranch, getEnvParam +from compiler/vm/vmdef import unreachable + +from compiler/utils/ropes import `$` + +# XXX: temporary import; needed for ``PassEnv`` +import compiler/vm/irpasses + +type + LocalId = int + ScopeId = int + + Scope = object + firstLocal: int ## an index into ``PProc.activeLocals`` + + # TODO: using -1 to represent unset for ``JoinPoint`` is problematic for a + # multitude of reasons. An ID-like distinct type should be used for + # it too! + finalizer: JoinPoint + handler: JoinPoint + + TBlock = object + label: PSym + start: JoinPoint + + scope: ScopeId ## the scope attached to this block + +type PProc* = object + sym*: PSym + + blocks: seq[TBlock] + variables: seq[LocalId] ## each non-temporary local in the order of their definition + + scopes: seq[Scope] + + activeLocals: seq[LocalId] + locals: Table[int, int] + + paramRemap: seq[int] # maps the parameter position given by ``TSym.position`` + ## to the index used for the IR. This is required in the case that + ## parameters are removed during the translation step (e.g. ``static T`` + ## parameters). The list is empty if the positions can be used directly + +type TCtx* = object + + irs*: IrStore3 + + prc*: PProc + + graph*: ModuleGraph # only needed for testing if a proc has a body + idgen*: IdGenerator # needed for creating magics on-demand + + magicPredicate*: proc (m: TMagic): bool {.noSideEffect, nimcall.} ## + ## Called to decided if a procedure with the given magic is to be treated + ## as a real procedure. Use 'true' to indicate yes - 'false' otherwise + # XXX: a proc is used instead of a ``set[TMagic]``, due to the latter being + # 33 bytes in size + + passEnv*: PassEnv + + module*: PSym + + config*: ConfigRef + + options*: set[TOption] + + # XXX: if constants would use their own ID namespace, `seensConst` could be + # a ``Slice[ConstId]`` + seenConsts: PackedSet[SymId] ## used for keeping track of which constants + ## still require scanning + collectedConsts*: seq[PSym] + + constData*: Table[SymId, PNode] + + defSyms*: DeferredSymbols + procs*: ProcedureEnv + types*: DeferredTypeGen + data*: LiteralData + + +type IrGenResult* = Result[IrStore3, SemReport] + +when defined(nimCompilerStacktraceHints): + import std/stackframes + +type + VmGenError = object of CatchableError + report: SemReport + +const + NormalExit = 0 + +func raiseVmGenError( + report: sink SemReport, + loc: TLineInfo, + inst: InstantiationInfo + ) {.noinline, noreturn.} = + report.location = some(loc) + report.reportInst = toReportLineInfo(inst) + raise (ref VmGenError)(report: report) + +func fail( + info: TLineInfo, + kind: ReportKind, + ast: PNode = nil, + sym: PSym = nil, + str: string = "", + loc: InstantiationInfo = instLoc() + ) {.noinline, noreturn.} = + raiseVmGenError( + SemReport(kind: kind, ast: ast, sym: sym, str: str), + info, + loc) + +func irSym(c: var TCtx, sym: PSym): IRIndex = + let id = c.defSyms.requestSym(sym) + c.irs.irSym(id) + +func irParam(c: var TCtx, sym: PSym): IRIndex = + c.irs.irParam(sym.position.uint32) + +func irGlobal(c: var TCtx, sym: PSym): IRIndex = + c.irSym(sym) + +func irConst(c: var TCtx, sym: PSym): IRIndex = + assert sym.kind == skConst + let id = c.defSyms.requestSym(sym) + + if not c.seenConsts.containsOrIncl(id): + # XXX: collecting constants should *not* be the responsibility of + # ``irgen``. But with constants still sharing their ID namespace with + # globals, it's the easiest solution for now + c.collectedConsts.add sym + c.constData[id] = astdef(sym) + + c.irs.irSym(id) + +func irLit(c: var TCtx, n: PNode): IRIndex = + let typ = + if n.typ != nil: + c.types.requestType(n.typ) + elif n.kind in nkStrLit..nkTripleStrLit: + # XXX: without type information, we cannot know if the string literal + # is supposed to be a Nim-string or cstring, and so fall back to + # unconditionally treating it as a Nim-string. Not doing so + # would result in the code-generator treating it as a cstring + # TODO: instead of this workaround, each occurence in the compiler where + # a string literal without type information is inserted needs to + # corrected instead. One such occurence is ``genEnumToStrProc``. + {.noSideEffect.}: + c.types.requestType(c.graph.getSysType(unknownLineInfo, tyString)) + else: + NoneType + + c.irs.irLit (c.data.add(n), typ) + +func irImm(c: var TCtx, val: SomeInteger): IRIndex = + # TODO: ``ntkImm(ediate)`` needs to be used here + c.irs.irLit (c.data.newLit(val), c.passEnv.sysTypes[tyInt]) + +template tryOrReturn(code): untyped = + try: + code + except VmGenError as e: + return IrGenResult.err(move e.report) + +func requestType(c: var TCtx, k: TTypeKind): TypeId = + {.cast(noSideEffect).}: + # XXX: ``getSysType`` has error reporting related side-effects + c.types.requestType(c.graph.getSysType(unknownLineInfo, k)) + +proc getTemp(cc: var TCtx; tt: PType): IRIndex + +func pushScope(p: var PProc; finalizer, handler = JoinPoint(-1)) = + p.scopes.add Scope(firstLocal: p.activeLocals.len, + finalizer: finalizer, handler: handler) + +func popScope(p: var PProc) = + # TODO: take ``PProc`` instead of ``TCtx`` + let scope = p.scopes.pop() + p.activeLocals.setLen(scope.firstLocal) + +# XXX: the emission of ``ntkLocEnd`` instructions is disabled for now. When +# building the compiler with ``enableLocEnd = true``, the total code IR +# memory usage increases by 70 MB (!) and the time taken to execute for +# all code passes increases by ~50%. There are two approaches on how to +# continue here: +# 1. reduce the amount of emitted ``ntkLocEnd`` instructions. Reuse +# duplicated cleanup sections (of which there are likely a lot) by +# leveraging the linked section. +# Reducing the amount of raise exits by taking ``sfNeverRaises`` and +# etc. into account will also reduce the amount of cleanup code. +# ``ntkLocEnd`` is a very small instruction and will only take up +# 8-byte instead of the current 32-byte after the packed code +# representation is used. Specifying a range of locals instead of only +# a single one would also help with reducing the amount of instructions. +# 2. use a different approach for transporting lifetime information to +# the analysis passes. For example, an out-of-band approach where the +# slice of locals for which the lifetime ends is attached to each +# '(goto|goto-link|continue)' instruction. That will be a problem if the +# code is changed between ``irgen`` and the analysis passes however. +const enableLocEnd = false + +proc handleExit(code: var IrStore3, prc: PProc, numScopes: int = 1) = + ## Emits the cleanup code for exiting the provided number of scopes + ## (`numScopes`). ``handleExit`` should be used before emitting control-flow + ## for leaving a scope in the non-exceptional case + var localsEnd = prc.activeLocals.len + for i in countdown(prc.scopes.high, prc.scopes.len-numScopes): + let s = prc.scopes[i] + # first destroy the locals in the scope, and only then execute the + # finalizer + when enableLocEnd: + for j in countdown(localsEnd - 1, s.firstLocal): + code.irLocEnd(prc.activeLocals[j]) + + localsEnd = s.firstLocal + + if s.finalizer != -1: + # the scope has a finalizer attached - visit it + code.irGotoLink(s.finalizer) + +proc cleanupScope(code: var IrStore3, prc: PProc) = + ## Emits a ``ntkLocEnd`` for each local in the current scope + let s = prc.scopes[^1] + when enableLocEnd: + for j in countdown(prc.activeLocals.high, s.firstLocal): + code.irLocEnd(prc.activeLocals[j]) + +proc handleRaise(code: var IrStore3, prc: PProc) = + ## Searches for the nearest scope that has an exception handler attached and + ## emits the cleanup logic for all scopes leading up to and including the + ## one with the found handler. Emits a 'goto' to the exception handler at the + ## end + var localsEnd = prc.activeLocals.len + for i in countdown(prc.scopes.high, 0): + let s = prc.scopes[i] + # first destroy the locals in the block + when enableLocEnd: + for j in countdown(localsEnd - 1, s.firstLocal): + code.irLocEnd(j) + + localsEnd = s.firstLocal + + if s.handler != -1: + # do not invoke the finalizer - that's the responsiblity of the + # exception handler + code.irGoto(s.handler) + return + + if s.finalizer != -1: + code.irGotoLink(s.finalizer) + + unreachable("no handler was found") + +proc genProcSym(c: var TCtx, s: PSym): IRIndex = + # prevent accidentally registering magics: + assert s.magic == mNone or c.magicPredicate(s.magic) + c.irs.irProc(): + if lfImportCompilerProc notin s.loc.flags: + # common case + c.procs.requestProc(s) + else: + # the procedure is an importc'ed ``.compilerproc`` --> use the + # referenced ``.compilerproc`` directly + c.passEnv.getCompilerProc($s.loc.r) + +func irCall*(ir: var IrStore3, callee: IRIndex, args: varargs[IRIndex]): IRIndex = + ## A shortcut for procedures taking only immutable arguments + for arg in args.items: + discard ir.irUse(arg) + ir.irCall(callee, args.len.uint32) + +func irCall(ir: var IrStore3, bc: BuiltinCall, typ: TypeId, args: varargs[IRIndex]): IRIndex = + ## A shortcut for procedures taking only immutable arguments + for arg in args.items: + discard ir.irUse(arg) + ir.irCall(bc, typ, args.len.uint32) + +func irCall(ir: var IrStore3, m: TMagic, typ: TypeId, args: varargs[IRIndex]): IRIndex = + ## A shortcut for procedures taking only immutable arguments + for arg in args.items: + discard ir.irUse(arg) + ir.irCall(m, typ, args.len.uint32) + +proc irCall(c: var TCtx, name: string, args: varargs[IRIndex]): IRIndex = + let prc = c.passEnv.getCompilerProc(name) + c.irs.irCall(c.irs.irProc(prc), args) + +func genLocal(c: var TCtx, kind: LocalKind, t: PType): IRIndex = + let + tid = c.types.requestType(t) + + c.irs.addLocal Local(kind: kind, typ: tid) + +func genLocal(c: var TCtx, kind: LocalKind, s: PSym): IRIndex = + # TODO: move `LocFlags` somewhere else + const LocFlags = {sfRegister, sfVolatile} ## flags that are relevant for locations + + let alignment = + case s.kind + of skVar, skLet, skForVar: s.alignment + else: 0 + + let local = Local(kind: kind, + typ: c.types.requestType(s.typ), + decl: c.defSyms.requestDecl(s), + loc: LocDesc(flags: s.flags * LocFlags, alignment: alignment.uint32)) + + c.irs.addLocal(local) + +func irNull(c: var TCtx, t: PType): IRIndex + +proc getTemp(cc: var TCtx; tt: PType): IRIndex = + let id = cc.genLocal(lkTemp, tt) + # XXX: zero-initializing the temporaries is better than the previous + # default-initialization, but there are still a few issues: + # - if the temporary is fully initialized (all of it's bits are written + # to prior to the first usage) it's unnecessary + # - the temporary should be implicitly zero-initialized. That is, a later + # pass that maps the IR's semantics to the target's semantics should + # be responsible for zero-initializing if required. With something + # like a ``ntkLocStart``, that's not going to be possible however. + discard cc.irs.irCall(bcInitLoc, cc.requestType(tyVoid), cc.irs.irLocal(id)) + cc.irs.irLocal(id) + +func irNull(c: var TCtx, t: TypeId): IRIndex = + # XXX: maybe `irNull` should be a dedicated IR node? + c.irs.irCall(mDefault, t, c.irs.irLit((NoneLit, t))) + +func irNull(c: var TCtx, t: PType): IRIndex = + # XXX: maybe `irNull` should be a dedicated IR node? + let t = c.types.requestType(t) + c.irs.irCall(mDefault, t, c.irs.irLit((NoneLit, t))) + +proc popBlock(c: var TCtx; oldLen: int) = + #for f in c.prc.blocks[oldLen].fixups: + # c.patch(f) + c.prc.blocks.setLen(oldLen) + +template withScope(body: untyped) {.dirty.} = + pushScope(c.prc) + body + popScope(c.prc) + +template withBlock(labl: PSym; next: JoinPoint; body: untyped) {.dirty.} = + var oldLen {.gensym.} = c.prc.blocks.len + withScope: + c.prc.blocks.add TBlock(label: labl, start: next, scope: c.prc.scopes.high) + body + popBlock(c, oldLen) + +proc gen(c: var TCtx; n: PNode; dest: var IRIndex) + +proc gen(c: var TCtx; n: PNode) = + doAssert n.typ.isEmptyType + var tmp: IRIndex + gen(c, n, tmp) + +proc genx(c: var TCtx; n: PNode): IRIndex = + #var tmp: TDest = -1 + #gen(c, n, tmp) + #internalAssert c.config, tmp >= 0 # 'nim check' does not like this internalAssert. + c.gen(n, result) + c.config.internalAssert(result != InvalidIndex, n.info, $n.kind) + +proc gen2(c: var TCtx, n: PNode): tuple[r: IRIndex, exits: bool] = + c.gen(n, result.r) + + # if the statement ends with a goto, the section doesn't have a structured + # exit + # XXX: it's probably a better idea to look at the `n` instead + result.exits = not c.irs.isLastAGoto() + +proc isNotOpr(n: PNode): bool = + n.kind in nkCallKinds and n[0].kind == nkSym and + n[0].sym.magic == mNot + +proc isTrue(n: PNode): bool = + n.kind == nkSym and n.sym.kind == skEnumField and n.sym.position != 0 or + n.kind == nkIntLit and n.intVal != 0 + +proc genStmt2(c: var TCtx, n: PNode): bool = + gen(c, n) + result = true # XXX: calculate the correct value + +proc genWhile(c: var TCtx; n: PNode, next: JoinPoint) = + # lab1: + # cond, tmp + # fjmp tmp, lab2 + # body + # jmp lab1 + # lab2: + var entrances: seq[IRIndex] + # XXX: the ``withBlock`` usage here is probably wrong now + withBlock(nil, next): + + c.prc.pushScope() + let loop = c.irs.irLoopJoin() + if isTrue(n[0]): + # don't emit a branch if the condition is always true + discard + else: + # TODO: omit the while loop if cond == false? + let + tmp = c.genx(n[0]) + fwd = c.irs.irJoinFwd() + + # XXX: the following pattern is quite common. Maybe ``ntkBranch`` should + # get an extra flag for indicating that it's an "unstructured branch" + # (or "conditional goto") so that the pattern can be replaced with + # just a branch? A ``ntkBranch`` is currently required to never + # jump out of the current logical scope + c.irs.irBranch(tmp, fwd) + # TODO: the condition expression might introduce locals. Are they part + # of the while's scope or of it's enclosing one? + c.irs.irGoto(next) + c.irs.irJoin(fwd) + + let exits = c.genStmt2(n[1]) + if exits: + # destroy locals defined inside the loop once an iteration finishes + handleExit(c.irs, c.prc) + discard c.irs.irGoto(loop) + #entrances.add(c.irs.irGetCf()) + + c.prc.popScope() + + #c.irs.irPatchStart(start, entrances) + + #result = c.irs.irJoin(c.prc.blocks[^1].endings) + +proc genBlock(c: var TCtx; n: PNode, next: JoinPoint): IRIndex = + withBlock(n[0].sym, next): + c.gen(n[1], result) + +iterator rmitems[T](x: var openArray[T]): var T = + var i = x.high + while i >= 0: + yield x[i] + dec i + +proc genBreak(c: var TCtx; n: PNode): IRIndex = + var i = c.prc.blocks.high + if n[0].kind == nkSym: + #echo cast[int](n[0].sym) + while i >= 0 and c.prc.blocks[i].label != n[0].sym: + dec i + + if i < 0: + # XXX: this isn't a user error + fail(n.info, rvmCannotFindBreakTarget) + + # exit all scopes including the one of the block we're breaking out of + handleExit(c.irs, c.prc, c.prc.scopes.len - c.prc.blocks[i].scope) + c.irs.irGoto(c.prc.blocks[i].start) + +proc genIf(c: var TCtx, n: PNode, next: JoinPoint): IRIndex = + # if (!expr1) goto lab1; + # thenPart + # goto LEnd + # lab1: + # if (!expr2) goto lab2; + # thenPart2 + # goto LEnd + # lab2: + # elsePart + # Lend: + + let hasValue = not isEmptyType(n.typ) + + var value: IRIndex + if hasValue: + value = c.getTemp(n.typ) + + var prev = next + for i in 0.. next + # asgn dest, b + + let tmp = c.getTemp(n.typ) + let a = c.genx(n[1]) + c.irs.irAsgn(askInit, tmp, a) + + let cond = + if isAnd: c.irs.irCall(mNot, c.requestType(tyBool), a) + else: a + + let p = c.irs.irBranch(cond, next) + + let b = c.genx(n[2]) + c.irs.irAsgn(askInit, tmp, b) + + result = tmp + +proc ofBranchToLit(d: var LiteralData, n: PNode, kind: TTypeKind): LiteralId = + ## Generates a literal from the given ``nkOfBranch`` node. If the branch has + ## only a single value, an atomic literal (int, string, float) is + ## generated - a slice-list otherwise + assert n.kind == nkOfBranch + const + IntTypes = {tyBool, tyChar, tyInt..tyInt64, tyUInt..tyUInt64, tyEnum} + FloatTypes = {tyFloat..tyFloat128} + + if n.len == 2 and n[0].kind != nkRange: + # a single-valued of-branch + result = + case kind + of IntTypes: d.newLit n[0].intVal + of FloatTypes: d.newLit n[0].floatVal + # TODO: also support cstrings + of tyString: d.newLit n[0].strVal + else: unreachable(kind) + + else: + # the branch uses a slice-list. They're stored as an array of pairs + var arr = d.startArray((n.len - 1) * 2) + + template addAll(field: untyped, kinds: set[TNodeKind]) = + for i in 0.. 1: + c.irs.irJoin(b) + + b = + if i < n.len - 1: c.irs.irJoinFwd() + else: next + + if branch.len == 1: + # else stmt: + if branch[0].kind != nkNilLit or branch[0].typ != nil: + # TODO: re-document the intention behind the if + r = c.gen2(branch[0]) + + else: + # elif branches were eliminated during transformation + doAssert branch.kind == nkOfBranch + + let lit = ofBranchToLit(c.data, branch, selType.kind) + let cond = c.irs.irCall(bcMatch, NoneType, tmp, c.irs.irLit((lit, NoneType))) + + c.irs.irBranch(c.irs.irCall(mNot, c.requestType(tyBool), cond), b) + r = c.gen2(branch.lastSon) + + if r[1]: + if hasValue and r[0] != InvalidIndex: + # `r[0]` is unset if `branch` ends in a void `noreturn` call, so we + # have to guard against that case + c.irs.irAsgn(askInit, dest, r[0]) + + handleExit(c.irs, c.prc) + c.irs.irGoto(next) + + result = dest + +func genTypeLit(c: var TCtx, t: PType): IRIndex + +func genExceptCond(c: var TCtx, val: IRIndex, n: PNode, next: JoinPoint) = + ## Lowers exception matching into an if + # XXX: maybe too early for this kind of lowering + # XXX: how the exception matching is implemented should be left to a later + # phase. That is, something like a ``bcMatchException`` should be + # emitted here instead + for i in 0.. 1 + + var currNext = JoinPoint(-1) + for i in 1..