From 5a76dca393fafa16352acba15984ba5d82be7669 Mon Sep 17 00:00:00 2001 From: zerbina <100542850+zerbina@users.noreply.github.com> Date: Thu, 13 Jul 2023 22:50:08 +0000 Subject: [PATCH 1/5] backend: make dynlib handling target-agnostic Summary ======= Make code generation for `.dynlib` procedure/variable setup target- agnostic and move it to the unified backend processing pipeline. Instead of as part of the *data-init* module operator, loading dynamic libraries and setting up the procedures and variables now happens in the the new *dynlib-init* module operator (which is called directly after the *data-init* operator). This fixes run-time expressions in `.dynlib` pragmas not being subject to destructor injection and removes the last `PNode` side-channel (i.e., AST reaching the code generators through something else than `genProc`). Details ======= The C code generator previously created globals for holding the handle of loaded libraries in an ad-hoc way, with the `PLib` associated with the symbol modified to store the generated C name. This same approach is not possible with the unified pipeline, and instead, more of the `TLib` related handling is moved into semantic analysis: - remove the `TLib.generated` field - store a symbol instead of a raw name in `TLib.name` - the symbol for each `PLib` of a module is generated when the module is closed - adjust `PackedLib` and the related load/store logic With this, a `TLib` is no longer modified outside of semantic analysis, and the code generators don't need to introduce ad-hoc globals. The queueing logic in `process` is adjusted to also consider imported `.dynlib` procedures, with them now having dedicated processing. When they're processed, the procedures are announced to `process`'s caller and the loader logic is generated and emitted. The generated loader logic is, apart from being generated as MIR code, stays as it was. One problem is with dynlib variables. How they're represented is left to the code generators, which means that a normal assignment cannot be used to initialize the internal representation. For this reason, a new internal magic (`mAsgnDynlibVar`) that is used for setting up a dynlib procedures/variables is introduced and implemented in `cgen`. Finally, the workarounds regarding dynlib procedures are removed from `cbackend` and `backends` and the everything dynlib-init specific is removed from `cgen`. Reporting dependencies on statically-known dynamic libraries is now handled in `cbackend`. While now theoretically possible, the JS and VM backend still don't support dynlib procedure and variables. --- compiler/ast/ast_types.nim | 6 +- compiler/backend/backends.nim | 245 +++++++++++++----- compiler/backend/cbackend.nim | 33 +-- compiler/backend/ccgexprs.nim | 11 + compiler/backend/cgen.nim | 128 ++------- compiler/backend/cgendata.nim | 3 - compiler/backend/jsbackend.nim | 2 + compiler/ic/ic.nim | 15 +- compiler/ic/packed_ast.nim | 3 +- compiler/mir/mirconstr.nim | 5 + compiler/sem/modulelowering.nim | 5 + compiler/sem/sem.nim | 11 + compiler/vm/vmbackend.nim | 4 + .../destructor/tdestructor_in_dynlib_expr.nim | 37 +++ 14 files changed, 299 insertions(+), 209 deletions(-) create mode 100644 tests/lang_objects/destructor/tdestructor_in_dynlib_expr.nim diff --git a/compiler/ast/ast_types.nim b/compiler/ast/ast_types.nim index 63fe2f6b8fe..3ffa106c882 100644 --- a/compiler/ast/ast_types.nim +++ b/compiler/ast/ast_types.nim @@ -1,5 +1,4 @@ import compiler/ast/lineinfos -import compiler/utils/ropes import std/[hashes] from compiler/ast/idents import PIdent, TIdent @@ -852,6 +851,8 @@ type mException, mBuiltinType, mSymOwner, mUncheckedArray, mGetImplTransf, mSymIsInstantiationOf, mNodeId, mPrivateAccess + # magics only used internally: + mAsgnDynlibVar # things that we can evaluate safely at compile time, even if not asked for it: const @@ -1610,9 +1611,8 @@ type TLib* = object ## also misused for headers! ## keep in sync with PackedLib kind*: TLibKind - generated*: bool ## needed for the backends: isOverriden*: bool - name*: Rope + name*: PSym path*: PNode ## can be a string literal! diff --git a/compiler/backend/backends.nim b/compiler/backend/backends.nim index 62cba8ebf16..40c0a20a491 100644 --- a/compiler/backend/backends.nim +++ b/compiler/backend/backends.nim @@ -3,6 +3,7 @@ import std/[ deques, + dynlib, # for computing possible candidate names intsets ], compiler/ast/[ @@ -19,6 +20,7 @@ import compiler/mir/[ astgen, mirbridge, + mirconstr, mirgen, mirtrees, sourcemaps @@ -92,6 +94,9 @@ type globals*: Queue[PSym] threadvars*: Queue[PSym] + libs*: seq[PLib] + ## all dynamic libraries that the alive graph depends on + additional: seq[tuple[m: FileIndex, prc: PSym]] # HACK: see documentation of the procedure that appends to this list @@ -115,6 +120,7 @@ type bekPartial ## a fragment of a procedure that's generated incrementally ## became available bekProcedure ## a complete procedure was processed and transformed + bekImported ## an alive runtime-imported procedure finished processing BackendEvent* = object ## Progress event returned by the ``process`` iterator. @@ -126,7 +132,7 @@ type case kind*: BackendEventKind of bekModule: discard - of bekPartial, bekProcedure: + of bekPartial, bekProcedure, bekImported: sym*: PSym ## the symbol of the procedure the event is about body*: MirFragment @@ -208,6 +214,7 @@ proc generateMain*(graph: ModuleGraph, modules: ModuleList, result: PNode) = # first initialize the additional data associated with each module: for it in closed(modules): emitOpCall(graph, it.dataInit, result) + emitOpCall(graph, it.dynlibInit, result) # the system module is special cased: its fully initialized during the # data-init phase if sfSystemModule in it.sym.flags: @@ -312,6 +319,10 @@ proc preprocess*(conf: BackendConfig, prc: PSym, graph: ModuleGraph, idgen: IdGenerator): Procedure = ## Transforms the body of the given procedure and translates it to MIR code. ## No MIR passes are applied yet + if exfDynamicLib in prc.extFlags: + # a procedure imported at runtime, it has no body + return Procedure(sym: prc, isImported: true) + result = Procedure(sym: prc, isImported: false) var body = transformBodyWithCache(graph, idgen, prc) @@ -451,6 +462,148 @@ proc produceFragmentsForGlobals(data: var DiscoveryData, identdefs: seq[PNode], finish(result.init, graph.emptyNode) finish(result.deinit, graph.emptyNode) +# ----- dynlib handling ----- + +proc genLoadLib(graph: ModuleGraph, buf: var MirNodeSeq, loc, name: MirNode) = + ## Emits the MIR code for ``loc = nimLoadLibrary(name); loc.isNil``. + let loadLib = graph.getCompilerProc("nimLoadLibrary") + + argBlock(buf): + chain(buf): emit(loc) => tag(ekReassign) => name() + argBlock(buf): + chain(buf): procLit(loadLib) => arg() + chain(buf): emit(name) => arg() + chain(buf): callOp(loadLib.typ[0]) => consume() + buf.add MirNode(kind: mnkAsgn) + + argBlock(buf): + chain(buf): emit(loc) => arg() + forward(buf): magicCall(mIsNil, graph.getSysType(unknownLineInfo, tyBool)) + +proc genLibSetup(graph: ModuleGraph, conf: BackendConfig, + name: PSym, path: PNode, dest: var MirFragment) = + ## Emits the MIR code for loading a dynamic library to `dest`, with `name` + ## being the symbol of the location that stores the handle and `path` the + ## expression used with the ``.dynlib`` pragma. + let + errorProc = graph.getCompilerProc("nimLoadLibraryError") + voidTyp = graph.getSysType(path.info, tyVoid) + nameNode = MirNode(kind: mnkGlobal, sym: name, typ: name.typ) + + template buf: MirNodeSeq = dest.tree + + if path.kind in nkStrKinds: + # the library name is known at compile-time + var candidates: seq[string] + libCandidates(path.strVal, candidates) + + let outer = LabelId(1) # labels are 1-based + + # generate an 'or' chain that tries every candidate until one is found + # for which loading succeeds + buf.subTree MirNode(kind: mnkBlock, label: outer): + buf.add MirNode(kind: mnkStmtList) # manual, for less visual nesting + for candidate in candidates.items: + genLoadLib(graph, buf, nameNode): + MirNode(kind: mnkLiteral, lit: newStrNode(nkStrLit, candidate)) + forward(buf): magicCall(mNot, graph.getSysType(path.info, tyBool)) + buf.subTree MirNode(kind: mnkIf): + buf.add MirNode(kind: mnkBreak, label: outer) + + # if none of the candidates worked, a run-time error is reported: + argBlock(buf): + chain(buf): procLit(errorProc) => arg() + chain(buf): literal(path) => arg() + chain(buf): callOp(voidTyp) => voidOut() + buf.add endNode(mnkStmtList) + else: + # the name of the dynamic library to load the procedure from is only known + # at run-time + let + nameTemp = TempId(0) # we can allocate a temporary here by just using it + strType = graph.getSysType(path.info, tyString) + + buf.subTree MirNode(kind: mnkDef): + buf.add MirNode(kind: mnkTemp, typ: strType, temp: nameTemp) + + # computing the string and assigning it to a temporary + argBlock(buf): + chain(buf): temp(strType, nameTemp) => tag(ekReassign) => name() + updateWithSource(dest, path) + generateCode(graph, conf.options, path, buf, dest.source) + buf.add MirNode(kind: mnkConsume, typ: strType) + buf.add MirNode(kind: mnkInit) + + genLoadLib(graph, buf, nameNode): + MirNode(kind: mnkTemp, typ: strType, temp: nameTemp) + buf.subTree MirNode(kind: mnkIf): + stmtList(buf): + argBlock(buf): + chain(buf): procLit(errorProc) => arg() + chain(buf): temp(strType, nameTemp) => arg() + chain(buf): callOp(voidTyp) => voidOut() + +proc produceLoader(graph: ModuleGraph, m: Module, data: var DiscoveryData, + conf: BackendConfig, sym: PSym): MirFragment = + ## Produces a MIR fragment with the load-at-run-time logic for procedure/ + ## variable `sym`. If not generated already, the loading logic for the + ## necessary dynamic library is emitted into the fragment and the global + ## storing the library handle registered with `data`. + let + lib = sym.annex + loadProc = graph.getCompilerProc("nimGetProcAddr") + path = transformExpr(graph, m.idgen, m.sym, lib.path) + extname = newStrNode(nkStrLit, sym.extname) + voidTyp = graph.getSysType(path.info, tyVoid) + + extname.typ = graph.getSysType(lib.path.info, tyCstring) + + let dest = + if sym.kind in routineKinds: + MirNode(kind: mnkProc, typ: sym.typ, sym: sym) + else: + MirNode(kind: mnkGlobal, typ: sym.typ, sym: sym) + + # the scope makes sure that locals are destroyed once loading the + # procedure has finished + result.tree.add MirNode(kind: mnkScope) + + if path.kind in nkCallKinds and path.typ != nil and + path.typ.kind in {tyPointer, tyProc}: + # a call expression for loading the procedure + path[^1] = extname # update to the correct name + # XXX: ^^ maybe sem should do this instead... + + argBlock(result.tree): + chain(result.tree): emit(dest) => tag(ekReassign) => name() + updateWithSource(result, path) + generateCode(graph, conf.options, path, result.tree, result.source) + result.tree.add MirNode(kind: mnkArg, typ: dest.typ) + chain(result.tree): magicCall(mAsgnDynlibVar, voidTyp) => voidOut() + else: + # the imported procedure is identified by the symbol's external name and + # the built-in proc loading logic is to be used + + if not data.seen.containsOrIncl(lib.name.id): + # the library hasn't been loaded yet + genLibSetup(graph, conf, lib.name, path, result) + if path.kind in nkStrKinds: # only register statically-known dependencies + data.libs.add lib + data.globals.add lib.name # register the global + + # generate the code for ``sym = cast[typ](nimGetProcAddr(lib, extname))`` + argBlock(result.tree): + chain(result.tree): emit(dest) => tag(ekReassign) => name() + argBlock(result.tree): + chain(result.tree): procLit(loadProc) => arg() + chain(result.tree): symbol(mnkGlobal, lib.name) => arg() + chain(result.tree): literal(extname) => arg() + chain(result.tree): callOp(loadProc.typ[0]) => arg() + chain(result.tree): magicCall(mAsgnDynlibVar, voidTyp) => voidOut() + + result.tree.add endNode(mnkScope) + updateWithSource(result, path) + # ----- discovery and queueing logic ----- func includeIfUnseen(q: var Queue[PSym], marker: var IntSet, sym: PSym) = @@ -525,8 +678,9 @@ func queue(iter: var ProcedureIter, prc: PSym, m: FileIndex) = ## `iter`'s queue. assert prc.kind in routineKinds if exfNoDecl notin prc.extFlags and - (sfImportc notin prc.flags or (iter.config.noImported and - prc.ast[bodyPos].kind != nkEmpty)): + (sfImportc notin prc.flags or + exfDynamicLib in prc.extFlags or (iter.config.noImported and + prc.ast[bodyPos].kind != nkEmpty)): iter.queued.add (prc, m) func queueAll(iter: var ProcedureIter, data: var DiscoveryData, @@ -555,47 +709,6 @@ proc next(iter: var ProcedureIter, graph: ModuleGraph, # apply all MIR passes: process(result.prc, graph, idgen) -proc preprocessDynlib(graph: ModuleGraph, idgen: IdGenerator, - sym: PSym, deps: var seq[PSym]) = - # HACK: so that procedures and unexpanded constants used in the - # expressions passed to `.dylib` pragmas are discovered, we - # translate the expression to MIR code, scan it, and then - # translate it back to AST and update the symbol with it. This is - # horrendous, but fortunately, this hack (`preprocessDynlib``) can - # be removed once handling of dynlib procedures and globals is fully - # implemented in the ``process`` iterator - if exfDynamicLib in sym.extFlags: - if sym.annex.path.kind in nkStrKinds: - # it's a string, no need to transform nor scan it - discard - else: - # XXX: the logic here ignores a large amount of things - # (options, proper owner symbol, etc.)... - var - t: MirTree - m: SourceMap - - generateCode(graph, {}, sym.annex.path, t, m) - for dep in deps(t, {}): # just ignore magics here - if dep.kind in routineKinds + {skConst}: - deps.add dep - - sym.annex.path = generateAST(graph, idgen, sym.owner, t, m) - -proc preprocessDynlib(graph: ModuleGraph, mlist: ModuleList, - data: var DiscoveryData) = - # XXX: remove this procedure once ``process`` is fully responsible for - # .dynlib handling - var deps: seq[PSym] - for _, it in peek(data.procedures): - preprocessDynlib(graph, mlist[moduleId(it).FileIndex].idgen, it, deps) - - for it in deps.items: - if it.kind in routineKinds: - register(data, procedures, it) - else: - register(data, constants, it) - func processConstants(data: var DiscoveryData): seq[(FileIndex, int)] = ## Registers with `data` the procedures used by all un-processed constants ## and marks the constants as processed. @@ -714,8 +827,6 @@ iterator process*(graph: ModuleGraph, modules: var ModuleList, for s in m.structs.threadvars.items: register(discovery, threadvars, s) - preprocessDynlib(graph, modules, discovery) - let ctx = preActions(discovery) # inform the caller that the initial set of alive entities became # available: @@ -727,12 +838,28 @@ iterator process*(graph: ModuleGraph, modules: var ModuleList, ## Reports (i.e., yields an event) a procedure-related event. discoverFrom(discovery, noMagics, frag.tree) - preprocessDynlib(graph, modules, discovery) - let work = preActions(discovery) yield BackendEvent(module: m, kind: evt, sym: prc, body: frag) postActions(iter, discovery, m, work) + template reportProgress(prc: PSym, frag: MirFragment) = + ## Applies the relevant passes to the fragment and notifies the caller + ## about it. + if not isEmpty(frag): + process(frag, prc, graph, modules[module].idgen) + reportBody(prc, module, bekPartial, frag) + + # mark the procedure as non-empty: + if prc.ast[bodyPos].kind == nkEmpty: + prc.ast[bodyPos] = newNode(nkStmtList) + + # generate the importing logic for all known dynlib globals: + for _, it in all(discovery.globals): + if exfDynamicLib in it.extFlags: + let module = moduleId(it).FileIndex + var frag = produceLoader(graph, modules[module], discovery, conf, it) + reportProgress(modules[module].dynlibInit, frag) + # process queued procedures until there are none left: while iter.queued.len > 0: let @@ -748,17 +875,6 @@ iterator process*(graph: ModuleGraph, modules: var ModuleList, produceFragmentsForGlobals(discovery, prc.globals, graph, conf.options) - template reportProgress(prc: PSym, frag: MirFragment) = - ## Applies the relevant passes, and notifies the caller about the - ## fragments. - if not isEmpty(frag): - process(frag, prc, graph, modules[module].idgen) - reportBody(prc, module, bekPartial, frag) - - # mark the procedure as non-empty: - if prc.ast[bodyPos].kind == nkEmpty: - prc.ast[bodyPos] = newNode(nkStmtList) - reportProgress(modules[module].preInit, init) reportProgress(modules[module].postDestructor, deinit) @@ -770,8 +886,15 @@ iterator process*(graph: ModuleGraph, modules: var ModuleList, reportBody(prc.sym, id, bekProcedure, prc.body) of true: - # a procedure imported at run-time (i.e. a .dynlib procedure) - discard "still managed by the code generator" + # a procedure imported at run-time (i.e., a dynlib procedure) + # first announce the procedure... + let ctx = preActions(discovery) + yield BackendEvent(module: module, kind: bekImported, sym: prc.sym) + postActions(iter, discovery, module, ctx) + + # ... then produce and announce the loader fragment: + var frag = produceLoader(graph, modules[module], discovery, conf, prc.sym) + reportProgress(modules[module].dynlibInit, frag) # ----- API for interacting with ``DiscoveryData`` ----- diff --git a/compiler/backend/cbackend.nim b/compiler/backend/cbackend.nim index de717e57a24..0ea60d3e891 100644 --- a/compiler/backend/cbackend.nim +++ b/compiler/backend/cbackend.nim @@ -67,6 +67,10 @@ import import std/options as std_options +from compiler/front/msgs import localReport +from compiler/ast/reports import ReportKind +from compiler/ast/reports_sem import SemReport + type InlineProc = object ## Information about an inline procedure. @@ -156,23 +160,6 @@ proc processEvent(g: BModuleList, inl: var InliningData, discovery: var Discover prepare(g, discovery) - # prepare the newly discovered dynlib procedures: - # XXX: dynlib procedure handling is going to move into the unified backend - # processing pipeline (i.e., the ``process`` iterator) in the future - for _, s in peek(discovery.procedures): - if exfDynamicLib in s.extFlags: - let m = g.modules[s.itemId.module.int] - fillProcLoc(m, s) - symInDynamicLib(m, s) - - if m != bmod: - # move the foreign dependencies into the global late-dependencies list, - # so that they will be registered as late late-dependencies - for it in m.extra.items: - g.hooks.add (m, it) - - m.extra.setLen(0) - proc handleInline(inl: var InliningData, m: ModuleId, prc: PSym, body: MirTree): Option[uint32] {.nimcall.} = ## Registers the dependency on inline procedure that `body` has @@ -221,9 +208,6 @@ proc processEvent(g: BModuleList, inl: var InliningData, discovery: var Discover dependOnCompilerProc(inl, discovery, evt.module, g.graph, "initThreadVarsEmulation") - # generating the code for the dynlib procedures might have raised some - # late dependencies: - processLate(bmod, discovery, inl, evt.module, none(uint32)) of bekPartial: # register inline dependencies: let inlineId = handleInline(inl, evt.module, evt.sym, evt.body.tree) @@ -262,6 +246,9 @@ proc processEvent(g: BModuleList, inl: var InliningData, discovery: var Discover bmod.s[cfsProcs].add(r) processLate(bmod, discovery, inl, evt.module, inlineId) + of bekImported: + # an imported procedure available + symInDynamicLib(bmod, evt.sym) proc emit(m: BModule, inl: InliningData, prc: InlineProc, r: var Rope) = ## Emits the inline procedure `prc` and all its inline dependencies into @@ -452,6 +439,12 @@ proc generateCode*(graph: ModuleGraph, g: BModuleList, mlist: sink ModuleList) = g.generatedHeader = generateHeader(g, inl, discovery, mlist[graph.config.projectMainIdx2].sym) + # not pretty, but here's the earliest point where we know about the set of + # all actually-used dynamic libraries + for lib in discovery.libs.items: + localReport(graph.config): + SemReport(kind: rsemHintLibDependency, str: lib.path.strVal) + # finalize code generation for the modules and generate and emit the code # for the 'main' procedure: for m in closed(mlist): diff --git a/compiler/backend/ccgexprs.nim b/compiler/backend/ccgexprs.nim index 6fce2b1cb90..1acf76957f5 100644 --- a/compiler/backend/ccgexprs.nim +++ b/compiler/backend/ccgexprs.nim @@ -1929,6 +1929,17 @@ proc genMagicExpr(p: BProc, e: PNode, d: var TLoc, op: TMagic) = of mAccessTypeField: genAccessTypeField(p, e, d) of mSlice: genSlice(p, e, d) of mTrace: discard "no code to generate" + of mAsgnDynlibVar: + # initialize the internal pointer for a dynlib global/procedure + var a, b: TLoc + initLocExpr(p, e[1][0], a) + initLocExpr(p, e[2], b) + var typ = getTypeDesc(p.module, a.t) + # dynlib variables are stored as pointers + if lfIndirect in a.flags: + typ.add "*" + + linefmt(p, cpsStmts, "$1 = ($2)($3);$n", [a.r, typ, rdLoc(b)]) else: when defined(debugMagics): echo p.prc.name.s, " ", p.prc.id, " ", p.prc.flags, " ", p.prc.ast[genericParamsPos].kind diff --git a/compiler/backend/cgen.nim b/compiler/backend/cgen.nim index 2938b7e8ccd..3384e093547 100644 --- a/compiler/backend/cgen.nim +++ b/compiler/backend/cgen.nim @@ -73,24 +73,9 @@ from compiler/ast/report_enums import ReportKind from compiler/sem/passes import moduleHasChanged # XXX: leftover dependency import std/strutils except `%`, addf # collides with ropes.`%` -import dynlib - when defined(nimCompilerStacktraceHints): import compiler/utils/debugutils -when not declared(dynlib.libCandidates): - proc libCandidates(s: string, dest: var seq[string]) = - ## given a library name pattern `s` write possible library names to `dest`. - var le = strutils.find(s, '(') - var ri = strutils.find(s, ')', le+1) - if le >= 0 and ri > le: - var prefix = substr(s, 0, le - 1) - var suffix = substr(s, ri + 1) - for middle in split(substr(s, le + 1, ri - 1), '|'): - libCandidates(prefix & middle & suffix, dest) - else: - dest.add(s) - when options.hasTinyCBackend: import backend/tccgen @@ -625,59 +610,6 @@ proc deinitFrame(p: BProc): Rope = include ccgexprs -# ----------------------------- dynamic library handling ----------------- -# We don't finalize dynamic libs as the OS does this for us. - -proc isGetProcAddr(lib: PLib): bool = - let n = lib.path - result = n.kind in nkCallKinds and n.typ != nil and - n.typ.kind in {tyPointer, tyProc} - -proc loadDynamicLib(m: BModule, lib: PLib) = - assert(lib != nil) - if not lib.generated: - lib.generated = true - var tmp = getTempName(m) - assert(lib.name == "") - lib.name = tmp # BUGFIX: cgsym has awful side-effects - m.s[cfsVars].addf("static void* $1;$n", [tmp]) - if lib.path.kind in {nkStrLit..nkTripleStrLit}: - var s: TStringSeq = @[] - libCandidates(lib.path.strVal, s) - localReport(m.config, reportStr( - rsemHintLibDependency, lib.path.strVal)) - - var loadlib = "" - for i in 0..high(s): - inc(m.labels) - if i > 0: loadlib.add("||") - let n = newStrNode(nkStrLit, s[i]) - n.info = lib.path.info - appcg(m, loadlib, "($1 = #nimLoadLibrary($2))$n", - [tmp, genStringLiteral(m, n)]) - appcg(m, m.s[cfsDynLibInit], - "if (!($1)) #nimLoadLibraryError($2);$n", - [loadlib, genStringLiteral(m, lib.path)]) - else: - var p = newProc(nil, m) - p.options.excl optStackTrace - p.flags.incl nimErrorFlagDisabled - var dest: TLoc - initLoc(dest, locTemp, lib.path, OnStack) - dest.r = getTempName(m) - appcg(m, m.s[cfsDynLibInit],"$1 $2;$n", - [getTypeDesc(m, lib.path.typ, skVar), rdLoc(dest)]) - expr(p, lib.path, dest) - - m.s[cfsVars].add(p.s(cpsLocals)) - m.s[cfsDynLibInit].add(p.s(cpsInit)) - m.s[cfsDynLibInit].add(p.s(cpsStmts)) - appcg(m, m.s[cfsDynLibInit], - "if (!($1 = #nimLoadLibrary($2))) #nimLoadLibraryError($2);$n", - [tmp, rdLoc(dest)]) - - m.config.internalAssert(lib.name != "", "loadDynamicLib") - proc mangleDynLibProc(sym: PSym): Rope = if sfCompilerProc in sym.flags: # NOTE: sym.extname is the external name! @@ -685,56 +617,22 @@ proc mangleDynLibProc(sym: PSym): Rope = else: result = rope(strutils.`%`("Dl_$1_", $sym.id)) +proc fillDynlibProcLoc(m: BModule, s: PSym) = + if s.locId == 0: + # XXX: a dynlib procedure is not really a ``locProc``, but rather a + # global variable + m.procs.put(s): ProcLoc(name: mangleDynLibProc(s), sym: s) + proc symInDynamicLib*(m: BModule, sym: PSym) = - var lib = sym.annex - let isCall = isGetProcAddr(lib) - let extname = sym.extname - if not isCall: loadDynamicLib(m, lib) - let tmp = mangleDynLibProc(sym) - # XXX: dynlib procedures should be treated as globals here (because that's - # what they are, really) - m.procs[sym].name = tmp # from now on we only need the internal name - sym.typ.sym = nil # generate a new name - inc(m.labels, 2) - if isCall: - let p = newProc(nil, m) - p.options = {} - p.flags.incl nimErrorFlagDisabled + fillDynlibProcLoc(m, sym) + m.s[cfsVars].addf("$2 $1;$n", + [m.procs[sym].name, getTypeDesc(m, sym.typ, skVar)]) - let n = lib.path - var a: TLoc - initLocExpr(p, n[0], a) - var params = rdLoc(a) & "(" - for i in 1.. Date: Sat, 15 Jul 2023 22:23:33 +0000 Subject: [PATCH 2/5] post-merge fixup --- compiler/backend/backends.nim | 6 +++--- compiler/backend/cbackend.nim | 3 ++- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/compiler/backend/backends.nim b/compiler/backend/backends.nim index 40c0a20a491..5b97640da80 100644 --- a/compiler/backend/backends.nim +++ b/compiler/backend/backends.nim @@ -94,7 +94,7 @@ type globals*: Queue[PSym] threadvars*: Queue[PSym] - libs*: seq[PLib] + libs*: seq[LibId] ## all dynamic libraries that the alive graph depends on additional: seq[tuple[m: FileIndex, prc: PSym]] @@ -550,7 +550,7 @@ proc produceLoader(graph: ModuleGraph, m: Module, data: var DiscoveryData, ## necessary dynamic library is emitted into the fragment and the global ## storing the library handle registered with `data`. let - lib = sym.annex + lib = graph.getLib(sym.annex) loadProc = graph.getCompilerProc("nimGetProcAddr") path = transformExpr(graph, m.idgen, m.sym, lib.path) extname = newStrNode(nkStrLit, sym.extname) @@ -588,7 +588,7 @@ proc produceLoader(graph: ModuleGraph, m: Module, data: var DiscoveryData, # the library hasn't been loaded yet genLibSetup(graph, conf, lib.name, path, result) if path.kind in nkStrKinds: # only register statically-known dependencies - data.libs.add lib + data.libs.add sym.annex data.globals.add lib.name # register the global # generate the code for ``sym = cast[typ](nimGetProcAddr(lib, extname))`` diff --git a/compiler/backend/cbackend.nim b/compiler/backend/cbackend.nim index 0ea60d3e891..a7718c2428e 100644 --- a/compiler/backend/cbackend.nim +++ b/compiler/backend/cbackend.nim @@ -443,7 +443,8 @@ proc generateCode*(graph: ModuleGraph, g: BModuleList, mlist: sink ModuleList) = # all actually-used dynamic libraries for lib in discovery.libs.items: localReport(graph.config): - SemReport(kind: rsemHintLibDependency, str: lib.path.strVal) + SemReport(kind: rsemHintLibDependency, + str: graph.getLib(lib).path.strVal) # finalize code generation for the modules and generate and emit the code # for the 'main' procedure: From a10474e239ea8fdb0bc0cc5612486fab6ed61e3f Mon Sep 17 00:00:00 2001 From: zerbina <100542850+zerbina@users.noreply.github.com> Date: Sat, 15 Jul 2023 22:23:33 +0000 Subject: [PATCH 3/5] sem: only create globals for dynlib `TLib`s A `TLib` is also used to store `.header` information, and for those instances no global is needed. --- compiler/ic/ic.nim | 9 ++++++--- compiler/sem/sem.nim | 12 +++++++----- 2 files changed, 13 insertions(+), 8 deletions(-) diff --git a/compiler/ic/ic.nim b/compiler/ic/ic.nim index 5d394df5163..edb5cec9fc5 100644 --- a/compiler/ic/ic.nim +++ b/compiler/ic/ic.nim @@ -387,7 +387,8 @@ proc storeType(t: PType; c: var PackedEncoder; m: var PackedModule): PackedItemI proc toPackedLib(l: TLib; c: var PackedEncoder; m: var PackedModule): PackedLib = result.kind = l.kind result.isOverriden = l.isOverriden - result.name = storeSymLater(l.name, c, m) + if l.kind == libDynamic: + result.name = storeSymLater(l.name, c, m) storeNode(result, l, path) proc storeSym*(s: PSym; c: var PackedEncoder; m: var PackedModule): PackedItemId = @@ -863,8 +864,10 @@ template loadAstBodyLazy(p, field) = proc loadLib(c: var PackedDecoder; g: var PackedModuleGraph; si: int; l: PackedLib): TLib = - result = TLib(isOverriden: l.isOverriden, kind: l.kind, - name: loadSym(c, g, si, l.name)) + result = TLib(isOverriden: l.isOverriden, kind: l.kind) + if l.kind == libDynamic: + result.name = loadSym(c, g, si, l.name) + loadAstBody(l, path) proc symBodyFromPacked(c: var PackedDecoder; g: var PackedModuleGraph; diff --git a/compiler/sem/sem.nim b/compiler/sem/sem.nim index 1c0798f5c5f..6e6ce291fdf 100644 --- a/compiler/sem/sem.nim +++ b/compiler/sem/sem.nim @@ -942,12 +942,14 @@ proc myClose(graph: ModuleGraph; context: PPassContext, n: PNode): PNode = # setup the symbols for the globals that store the handles of loaded # dynamic libraries: for id, it in c.libs: - let info = c.module.info - let s = newSym(skVar, c.cache.getIdent("lib" & $id.index), + if it.kind == libDynamic: + let + info = c.module.info + s = newSym(skVar, c.cache.getIdent("lib" & $id.index), nextSymId(c.idgen), c.module, info) - s.typ = graph.getSysType(info, tyPointer) - s.flags.incl sfGlobal - it.name = s + s.typ = graph.getSysType(info, tyPointer) + s.flags.incl sfGlobal + it.name = s storeLibs(graph, c.idgen.module) closeScope(c) # close module's scope From 83c8218f472260965d99fd820162d4d822b94814 Mon Sep 17 00:00:00 2001 From: zerbina <100542850+zerbina@users.noreply.github.com> Date: Sat, 15 Jul 2023 22:23:33 +0000 Subject: [PATCH 4/5] cbackend: add a note regarding `localReport` usage --- compiler/backend/cbackend.nim | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/compiler/backend/cbackend.nim b/compiler/backend/cbackend.nim index a7718c2428e..58e4a1ab716 100644 --- a/compiler/backend/cbackend.nim +++ b/compiler/backend/cbackend.nim @@ -67,6 +67,9 @@ import import std/options as std_options +# XXX: reports are a legacy facility that is going to be phased out. A +# note on how to move forward is left at each usage site in this +# module from compiler/front/msgs import localReport from compiler/ast/reports import ReportKind from compiler/ast/reports_sem import SemReport @@ -441,6 +444,9 @@ proc generateCode*(graph: ModuleGraph, g: BModuleList, mlist: sink ModuleList) = # not pretty, but here's the earliest point where we know about the set of # all actually-used dynamic libraries + # XXX: instead of reporting them here, we could return the list to the + # caller, which is in a better position to decide what to do with + # it for lib in discovery.libs.items: localReport(graph.config): SemReport(kind: rsemHintLibDependency, From e0ed19c2bfafe9d746516f6a82dc8ba7ebb8f2da Mon Sep 17 00:00:00 2001 From: zerbina <100542850+zerbina@users.noreply.github.com> Date: Sun, 16 Jul 2023 12:31:33 +0000 Subject: [PATCH 5/5] tests: fix the test On non-Windows systems, an extra message is echoed on library loading failure. --- tests/lang_objects/destructor/tdestructor_in_dynlib_expr.nim | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/lang_objects/destructor/tdestructor_in_dynlib_expr.nim b/tests/lang_objects/destructor/tdestructor_in_dynlib_expr.nim index 2cfefee8769..69ab5e99a74 100644 --- a/tests/lang_objects/destructor/tdestructor_in_dynlib_expr.nim +++ b/tests/lang_objects/destructor/tdestructor_in_dynlib_expr.nim @@ -4,7 +4,7 @@ discard """ Run-time expressions used with the `.dynlib` pragma are also affected by destructor injection ''' - output: "could not load: non_existent_library_name" + outputsub: "could not load: non_existent_library_name" exitcode: 1 """