From 3b69a8d27a6b87bcb3440b5dae4aa2f618204264 Mon Sep 17 00:00:00 2001 From: Araq Date: Sat, 19 Apr 2014 22:24:43 +0200 Subject: [PATCH] New concurrency model: next steps --- compiler/ast.nim | 20 ++-- compiler/astalgo.nim | 4 +- compiler/lowerings.nim | 4 +- compiler/msgs.nim | 10 +- compiler/pragmas.nim | 35 ++++++- compiler/sempass2.nim | 112 +++++++++++++++++++--- compiler/sigmatch.nim | 2 +- compiler/wordrecg.nim | 11 ++- doc/manual.txt | 104 +++++--------------- lib/packages/docutils/rst.nim | 4 +- lib/posix/epoll.nim | 2 + lib/posix/inotify.nim | 2 + lib/posix/linux.nim | 5 +- lib/posix/posix.nim | 2 + lib/system.nim | 114 ++++++++++++---------- lib/system/avltree.nim | 4 +- lib/system/cgprocs.nim | 4 +- lib/system/excpt.nim | 12 +-- lib/system/gc.nim | 21 +++-- lib/system/hti.nim | 2 +- lib/system/syslocks.nim | 12 +-- lib/system/sysspawn.nim | 172 ++++++++++++++++++++++++++++++++++ lib/windows/winlean.nim | 2 +- 23 files changed, 460 insertions(+), 200 deletions(-) create mode 100644 lib/system/sysspawn.nim diff --git a/compiler/ast.nim b/compiler/ast.nim index e720d2bfaa..e575f317d7 100644 --- a/compiler/ast.nim +++ b/compiler/ast.nim @@ -13,7 +13,7 @@ import msgs, hashes, nversion, options, strutils, crc, ropes, idents, lists, intsets, idgen -type +type TCallingConvention* = enum ccDefault, # proc has no explicit calling convention ccStdCall, # procedure is stdcall @@ -299,7 +299,7 @@ const nkEffectList* = nkArgList # hacks ahead: an nkEffectList is a node with 4 children: exceptionEffects* = 0 # exceptions at position 0 - readEffects* = 1 # read effects at position 1 + usesEffects* = 1 # read effects at position 1 writeEffects* = 2 # write effects at position 2 tagEffects* = 3 # user defined tag ('gc', 'time' etc.) effectListLen* = 4 # list of effects list @@ -432,7 +432,7 @@ type tfAcyclic, # type is acyclic (for GC optimization) tfEnumHasHoles, # enum cannot be mapped into a range tfShallow, # type can be shallow copied on assignment - tfThread, # proc type is marked as ``thread`` + tfThread, # proc type is marked as ``thread``; alias for ``gcsafe`` tfFromGeneric, # type is an instantiation of a generic; this is needed # because for instantiations of objects, structural # type equality has to be used @@ -509,6 +509,7 @@ const tfIncompleteStruct* = tfVarargs tfUncheckedArray* = tfVarargs tfUnion* = tfNoSideEffect + tfGcSafe* = tfThread skError* = skUnknown # type flags that are essential for type equality: @@ -978,6 +979,8 @@ template `{}=`*(n: PNode, i: int, s: PNode): stmt = var emptyNode* = newNode(nkEmpty) # There is a single empty node that is shared! Do not overwrite it! +var anyGlobal* = newSym(skVar, getIdent("*"), nil, unknownLineInfo()) + proc isMetaType*(t: PType): bool = return t.kind in tyMetaTypes or (t.kind == tyStatic and t.n == nil) or @@ -1310,8 +1313,7 @@ proc skipTypes*(t: PType, kinds: TTypeKinds): PType = proc propagateToOwner*(owner, elem: PType) = const HaveTheirOwnEmpty = {tySequence, tySet} - owner.flags = owner.flags + (elem.flags * {tfHasShared, tfHasMeta, - tfHasGCedMem}) + owner.flags = owner.flags + (elem.flags * {tfHasShared, tfHasMeta}) if tfNotNil in elem.flags: if owner.kind in {tyGenericInst, tyGenericBody, tyGenericInvokation}: owner.flags.incl tfNotNil @@ -1328,9 +1330,11 @@ proc propagateToOwner*(owner, elem: PType) = if elem.isMetaType: owner.flags.incl tfHasMeta - if elem.kind in {tyString, tyRef, tySequence} or - elem.kind == tyProc and elem.callConv == ccClosure: - owner.flags.incl tfHasGCedMem + if owner.kind != tyProc: + if elem.kind in {tyString, tyRef, tySequence} or + elem.kind == tyProc and elem.callConv == ccClosure or + tfHasGCedMem in elem.flags: + owner.flags.incl tfHasGCedMem proc rawAddSon*(father, son: PType) = if isNil(father.sons): father.sons = @[] diff --git a/compiler/astalgo.nim b/compiler/astalgo.nim index 36dd7f5623..dbf13f7640 100644 --- a/compiler/astalgo.nim +++ b/compiler/astalgo.nim @@ -448,9 +448,9 @@ proc debug(n: PSym) = writeln(stdout, "skUnknown") else: #writeln(stdout, ropeToStr(symToYaml(n, 0, 1))) - writeln(stdout, ropeToStr(ropef("$1_$2: $3, $4", [ + writeln(stdout, ropeToStr(ropef("$1_$2: $3, $4, $5", [ toRope(n.name.s), toRope(n.id), flagsToStr(n.flags), - flagsToStr(n.loc.flags)]))) + flagsToStr(n.loc.flags), lineInfoToStr(n.info)]))) proc debug(n: PType) = writeln(stdout, ropeToStr(debugType(n))) diff --git a/compiler/lowerings.nim b/compiler/lowerings.nim index bee3427f4a..0ca07e8285 100644 --- a/compiler/lowerings.nim +++ b/compiler/lowerings.nim @@ -151,6 +151,8 @@ proc wrapProcForSpawn*(owner: PSym; n: PNode): PNode = if n.kind notin nkCallKinds or not n.typ.isEmptyType: localError(n.info, "'spawn' takes a call expression of type void") return + if {tfThread, tfNoSideEffect} * n[0].typ.flags == {}: + localError(n.info, "'spawn' takes a GC safe call expression") var threadParam = newSym(skParam, getIdent"thread", owner, n.info) argsParam = newSym(skParam, getIdent"args", owner, n.info) @@ -196,7 +198,7 @@ proc wrapProcForSpawn*(owner: PSym; n: PNode): PNode = # we pick n's type here, which hopefully is 'tyArray' and not # 'tyOpenArray': var argType = n[i].typ.skipTypes(abstractInst) - if argType.kind == tyVar: + if i < formals.len and formals[i].typ.kind == tyVar: localError(n[i].info, "'spawn'ed function cannot have a 'var' parameter") elif containsTyRef(argType): localError(n[i].info, "'spawn'ed function cannot refer to 'ref'/closure") diff --git a/compiler/msgs.nim b/compiler/msgs.nim index a63fbca7fc..7ad393b4de 100644 --- a/compiler/msgs.nim +++ b/compiler/msgs.nim @@ -118,7 +118,7 @@ type warnNilStatement, warnAnalysisLoophole, warnDifferentHeaps, warnWriteToForeignHeap, warnImplicitClosure, warnEachIdentIsTuple, warnShadowIdent, - warnProveInit, warnProveField, warnProveIndex, + warnProveInit, warnProveField, warnProveIndex, warnGcUnsafe, warnUninit, warnGcMem, warnUser, hintSuccess, hintSuccessX, hintLineTooLong, hintXDeclaredButNotUsed, hintConvToBaseNotNeeded, @@ -386,6 +386,7 @@ const warnProveInit: "Cannot prove that '$1' is initialized. This will become a compile time error in the future. [ProveInit]", warnProveField: "cannot prove that field '$1' is accessible [ProveField]", warnProveIndex: "cannot prove index '$1' is valid [ProveIndex]", + warnGcUnsafe: "not GC-safe: '$1' [GcUnsafe]", warnUninit: "'$1' might not have been initialized [Uninit]", warnGcMem: "'$1' uses GC'ed memory [GcMem]", warnUser: "$1 [User]", @@ -407,7 +408,7 @@ const hintUser: "$1 [User]"] const - WarningsToStr*: array[0..24, string] = ["CannotOpenFile", "OctalEscape", + WarningsToStr*: array[0..25, string] = ["CannotOpenFile", "OctalEscape", "XIsNeverRead", "XmightNotBeenInit", "Deprecated", "ConfigDeprecated", "SmallLshouldNotBeUsed", "UnknownMagic", @@ -415,7 +416,8 @@ const "CommentXIgnored", "NilStmt", "AnalysisLoophole", "DifferentHeaps", "WriteToForeignHeap", "ImplicitClosure", "EachIdentIsTuple", "ShadowIdent", - "ProveInit", "ProveField", "ProveIndex", "Uninit", "GcMem", "User"] + "ProveInit", "ProveField", "ProveIndex", "GcUnsafe", "Uninit", + "GcMem", "User"] HintsToStr*: array[0..15, string] = ["Success", "SuccessX", "LineTooLong", "XDeclaredButNotUsed", "ConvToBaseNotNeeded", "ConvFromXtoItselfNotNeeded", @@ -557,7 +559,7 @@ proc sourceLine*(i: TLineInfo): PRope var gNotes*: TNoteKinds = {low(TNoteKind)..high(TNoteKind)} - {warnShadowIdent, warnUninit, - warnProveField, warnProveIndex} + warnProveField, warnProveIndex, warnGcUnsafe} gErrorCounter*: int = 0 # counts the number of errors gHintCounter*: int = 0 gWarnCounter*: int = 0 diff --git a/compiler/pragmas.nim b/compiler/pragmas.nim index 14d1555393..88fa516bf3 100644 --- a/compiler/pragmas.nim +++ b/compiler/pragmas.nim @@ -24,7 +24,7 @@ const wCompilerproc, wProcVar, wDeprecated, wVarargs, wCompileTime, wMerge, wBorrow, wExtern, wImportCompilerProc, wThread, wImportCpp, wImportObjC, wAsmNoStackFrame, wError, wDiscardable, wNoInit, wDestructor, wCodegenDecl, - wGensym, wInject, wRaises, wTags, wOperator, wDelegator} + wGensym, wInject, wRaises, wTags, wUses, wOperator, wDelegator, wGcSafe} converterPragmas* = procPragmas methodPragmas* = procPragmas templatePragmas* = {wImmediate, wDeprecated, wError, wGensym, wInject, wDirty, @@ -35,7 +35,7 @@ const iteratorPragmas* = {FirstCallConv..LastCallConv, wNosideeffect, wSideeffect, wImportc, wExportc, wNodecl, wMagic, wDeprecated, wBorrow, wExtern, wImportCpp, wImportObjC, wError, wDiscardable, wGensym, wInject, wRaises, - wTags, wOperator} + wTags, wUses, wOperator, wGcSafe} exprPragmas* = {wLine} stmtPragmas* = {wChecks, wObjChecks, wFieldChecks, wRangechecks, wBoundchecks, wOverflowchecks, wNilchecks, wAssertions, wWarnings, wHints, @@ -48,7 +48,7 @@ const lambdaPragmas* = {FirstCallConv..LastCallConv, wImportc, wExportc, wNodecl, wNosideeffect, wSideeffect, wNoreturn, wDynlib, wHeader, wDeprecated, wExtern, wThread, wImportCpp, wImportObjC, wAsmNoStackFrame, - wRaises, wTags} + wRaises, wUses, wTags, wGcSafe} typePragmas* = {wImportc, wExportc, wDeprecated, wMagic, wAcyclic, wNodecl, wPure, wHeader, wCompilerproc, wFinal, wSize, wExtern, wShallow, wImportCpp, wImportObjC, wError, wIncompleteStruct, wByCopy, wByRef, @@ -64,7 +64,7 @@ const wExtern, wImportCpp, wImportObjC, wError, wGensym, wInject} letPragmas* = varPragmas procTypePragmas* = {FirstCallConv..LastCallConv, wVarargs, wNosideeffect, - wThread, wRaises, wTags} + wThread, wRaises, wUses, wTags, wGcSafe} allRoutinePragmas* = procPragmas + iteratorPragmas + lambdaPragmas proc pragma*(c: PContext, sym: PSym, n: PNode, validPragmas: TSpecialWords) @@ -513,6 +513,27 @@ proc pragmaRaisesOrTags(c: PContext, n: PNode) = else: invalidPragma(n) +proc pragmaUses(c: PContext, n: PNode) = + proc processExc(c: PContext, x: PNode): PNode = + if x.kind in {nkAccQuoted, nkIdent, nkSym, + nkOpenSymChoice, nkClosedSymChoice}: + if considerAcc(x).s == "*": + return newSymNode(ast.anyGlobal) + result = c.semExpr(c, x) + if result.kind != nkSym or sfGlobal notin result.sym.flags: + localError(x.info, "'$1' is not a global variable" % result.renderTree) + result = newSymNode(ast.anyGlobal) + + if n.kind == nkExprColonExpr: + let it = n.sons[1] + if it.kind notin {nkCurly, nkBracket}: + n.sons[1] = processExc(c, it) + else: + for i in 0 .. we need a stack of scopes for this analysis """ +const trackGlobals = false ## we don't need it for now + type TEffects = object exc: PNode # stack of exceptions tags: PNode # list of tags + uses: PNode # list of used global variables bottom: int owner: PSym init: seq[int] # list of initialized variables guards: TModel # nested guards locked: seq[PNode] # locked locations + gcUnsafe: bool PEffects = var TEffects proc isLocalVar(a: PEffects, s: PSym): bool = @@ -89,20 +93,29 @@ proc initVarViaNew(a: PEffects, n: PNode) = # are initialized: initVar(a, n) +when trackGlobals: + proc addUse(a: PEffects, e: PNode) = + var aa = a.uses + for i in 0 .. ".} + arg: pointer; ptid: ptr TPid; tls: pointer; + ctid: ptr TPid): cint {.importc, header: "".} diff --git a/lib/posix/posix.nim b/lib/posix/posix.nim index 131f23fddf..e206447cc5 100644 --- a/lib/posix/posix.nim +++ b/lib/posix/posix.nim @@ -27,6 +27,8 @@ ## resulting C code will just ``#include `` and *not* define the ## symbols declared here. +{.deadCodeElim:on.} + from times import TTime const diff --git a/lib/system.nim b/lib/system.nim index dae418b7f7..ede9eae593 100644 --- a/lib/system.nim +++ b/lib/system.nim @@ -192,6 +192,9 @@ when defined(nimNewShared): type `shared`* {.magic: "Shared".} guarded* {.magic: "Guarded".} +else: + {.pragma: gcsafe.} +#{.pragma: gcsafe.} const NoFakeVars* = defined(NimrodVM) ## true if the backend doesn't support \ ## "fake variables" like 'var EBADF {.importc.}: cint'. @@ -1207,20 +1210,20 @@ proc substr*(s: string, first, last: int): string {. ## or `limit`:idx: a string's length. when not defined(nimrodVM): - proc zeroMem*(p: pointer, size: int) {.importc, noDecl.} + proc zeroMem*(p: pointer, size: int) {.importc, noDecl, gcsafe.} ## overwrites the contents of the memory at ``p`` with the value 0. ## Exactly ``size`` bytes will be overwritten. Like any procedure ## dealing with raw memory this is *unsafe*. proc copyMem*(dest, source: pointer, size: int) {. - importc: "memcpy", header: "".} + importc: "memcpy", header: "", gcsafe.} ## copies the contents from the memory at ``source`` to the memory ## at ``dest``. Exactly ``size`` bytes will be copied. The memory ## regions may not overlap. Like any procedure dealing with raw ## memory this is *unsafe*. proc moveMem*(dest, source: pointer, size: int) {. - importc: "memmove", header: "".} + importc: "memmove", header: "", gcsafe.} ## copies the contents from the memory at ``source`` to the memory ## at ``dest``. Exactly ``size`` bytes will be copied. The memory ## regions may overlap, ``moveMem`` handles this case appropriately @@ -1235,14 +1238,14 @@ when not defined(nimrodVM): ## *unsafe*. when hostOS != "standalone": - proc alloc*(size: int): pointer {.noconv, rtl, tags: [].} + proc alloc*(size: int): pointer {.noconv, rtl, tags: [], gcsafe.} ## allocates a new memory block with at least ``size`` bytes. The ## block has to be freed with ``realloc(block, 0)`` or ## ``dealloc(block)``. The block is not initialized, so reading ## from it before writing to it is undefined behaviour! ## The allocated memory belongs to its allocating thread! ## Use `allocShared` to allocate from a shared heap. - proc createU*(T: typedesc, size = 1.Positive): ptr T {.inline.} = + proc createU*(T: typedesc, size = 1.Positive): ptr T {.inline, gcsafe.} = ## allocates a new memory block with at least ``T.sizeof * size`` ## bytes. The block has to be freed with ``resize(block, 0)`` or ## ``free(block)``. The block is not initialized, so reading @@ -1250,14 +1253,14 @@ when not defined(nimrodVM): ## The allocated memory belongs to its allocating thread! ## Use `createSharedU` to allocate from a shared heap. cast[ptr T](alloc(T.sizeof * size)) - proc alloc0*(size: int): pointer {.noconv, rtl, tags: [].} + proc alloc0*(size: int): pointer {.noconv, rtl, tags: [], gcsafe.} ## allocates a new memory block with at least ``size`` bytes. The ## block has to be freed with ``realloc(block, 0)`` or ## ``dealloc(block)``. The block is initialized with all bytes ## containing zero, so it is somewhat safer than ``alloc``. ## The allocated memory belongs to its allocating thread! ## Use `allocShared0` to allocate from a shared heap. - proc create*(T: typedesc, size = 1.Positive): ptr T {.inline.} = + proc create*(T: typedesc, size = 1.Positive): ptr T {.inline, gcsafe.} = ## allocates a new memory block with at least ``T.sizeof * size`` ## bytes. The block has to be freed with ``resize(block, 0)`` or ## ``free(block)``. The block is initialized with all bytes @@ -1265,7 +1268,8 @@ when not defined(nimrodVM): ## The allocated memory belongs to its allocating thread! ## Use `createShared` to allocate from a shared heap. cast[ptr T](alloc0(T.sizeof * size)) - proc realloc*(p: pointer, newSize: int): pointer {.noconv, rtl, tags: [].} + proc realloc*(p: pointer, newSize: int): pointer {.noconv, rtl, tags: [], + gcsafe.} ## grows or shrinks a given memory block. If p is **nil** then a new ## memory block is returned. In either way the block has at least ## ``newSize`` bytes. If ``newSize == 0`` and p is not **nil** @@ -1273,7 +1277,7 @@ when not defined(nimrodVM): ## be freed with ``dealloc``. ## The allocated memory belongs to its allocating thread! ## Use `reallocShared` to reallocate from a shared heap. - proc resize*[T](p: ptr T, newSize: Natural): ptr T {.inline.} = + proc resize*[T](p: ptr T, newSize: Natural): ptr T {.inline, gcsafe.} = ## grows or shrinks a given memory block. If p is **nil** then a new ## memory block is returned. In either way the block has at least ## ``T.sizeof * newSize`` bytes. If ``newSize == 0`` and p is not @@ -1282,7 +1286,7 @@ when not defined(nimrodVM): ## its allocating thread! ## Use `resizeShared` to reallocate from a shared heap. cast[ptr T](realloc(p, T.sizeof * newSize)) - proc dealloc*(p: pointer) {.noconv, rtl, tags: [].} + proc dealloc*(p: pointer) {.noconv, rtl, tags: [], gcsafe.} ## frees the memory allocated with ``alloc``, ``alloc0`` or ## ``realloc``. This procedure is dangerous! If one forgets to ## free the memory a leak occurs; if one tries to access freed @@ -1290,22 +1294,23 @@ when not defined(nimrodVM): ## or other memory may be corrupted. ## The freed memory must belong to its allocating thread! ## Use `deallocShared` to deallocate from a shared heap. - proc free*[T](p: ptr T) {.inline.} = + proc free*[T](p: ptr T) {.inline, gcsafe.} = dealloc(p) - proc allocShared*(size: int): pointer {.noconv, rtl.} + proc allocShared*(size: int): pointer {.noconv, rtl, gcsafe.} ## allocates a new memory block on the shared heap with at ## least ``size`` bytes. The block has to be freed with ## ``reallocShared(block, 0)`` or ``deallocShared(block)``. The block ## is not initialized, so reading from it before writing to it is ## undefined behaviour! - proc createSharedU*(T: typedesc, size = 1.Positive): ptr T {.inline.} = + proc createSharedU*(T: typedesc, size = 1.Positive): ptr T {.inline, + gcsafe.} = ## allocates a new memory block on the shared heap with at ## least ``T.sizeof * size`` bytes. The block has to be freed with ## ``resizeShared(block, 0)`` or ``freeShared(block)``. The block ## is not initialized, so reading from it before writing to it is ## undefined behaviour! cast[ptr T](allocShared(T.sizeof * size)) - proc allocShared0*(size: int): pointer {.noconv, rtl.} + proc allocShared0*(size: int): pointer {.noconv, rtl, gcsafe.} ## allocates a new memory block on the shared heap with at ## least ``size`` bytes. The block has to be freed with ## ``reallocShared(block, 0)`` or ``deallocShared(block)``. @@ -1318,7 +1323,8 @@ when not defined(nimrodVM): ## The block is initialized with all bytes ## containing zero, so it is somewhat safer than ``createSharedU``. cast[ptr T](allocShared0(T.sizeof * size)) - proc reallocShared*(p: pointer, newSize: int): pointer {.noconv, rtl.} + proc reallocShared*(p: pointer, newSize: int): pointer {.noconv, rtl, + gcsafe.} ## grows or shrinks a given memory block on the heap. If p is **nil** ## then a new memory block is returned. In either way the block has at ## least ``newSize`` bytes. If ``newSize == 0`` and p is not **nil** @@ -1331,13 +1337,13 @@ when not defined(nimrodVM): ## not **nil** ``resizeShared`` calls ``freeShared(p)``. In other ## cases the block has to be freed with ``freeShared``. cast[ptr T](reallocShared(p, T.sizeof * newSize)) - proc deallocShared*(p: pointer) {.noconv, rtl.} + proc deallocShared*(p: pointer) {.noconv, rtl, gcsafe.} ## frees the memory allocated with ``allocShared``, ``allocShared0`` or ## ``reallocShared``. This procedure is dangerous! If one forgets to ## free the memory a leak occurs; if one tries to access freed ## memory (or just freeing it twice!) a core dump may happen ## or other memory may be corrupted. - proc freeShared*[T](p: ptr T) {.inline.} = + proc freeShared*[T](p: ptr T) {.inline, gcsafe.} = ## frees the memory allocated with ``createShared``, ``createSharedU`` or ## ``resizeShared``. This procedure is dangerous! If one forgets to ## free the memory a leak occurs; if one tries to access freed @@ -1898,7 +1904,7 @@ const nimrodStackTrace = compileOption("stacktrace") # of the code var - globalRaiseHook*: proc (e: ref E_Base): bool {.nimcall.} + globalRaiseHook*: proc (e: ref E_Base): bool {.nimcall, gcsafe.} ## with this hook you can influence exception handling on a global level. ## If not nil, every 'raise' statement ends up calling this hook. Ordinary ## application code should never set this hook! You better know what you @@ -1906,7 +1912,7 @@ var ## exception is caught and does not propagate further through the call ## stack. - localRaiseHook* {.threadvar.}: proc (e: ref E_Base): bool {.nimcall.} + localRaiseHook* {.threadvar.}: proc (e: ref E_Base): bool {.nimcall, gcsafe.} ## with this hook you can influence exception handling on a ## thread local level. ## If not nil, every 'raise' statement ends up calling this hook. Ordinary @@ -1914,7 +1920,7 @@ var ## do when setting this. If ``localRaiseHook`` returns false, the exception ## is caught and does not propagate further through the call stack. - outOfMemHook*: proc () {.nimcall, tags: [].} + outOfMemHook*: proc () {.nimcall, tags: [], gcsafe.} ## set this variable to provide a procedure that should be called ## in case of an `out of memory`:idx: event. The standard handler ## writes an error message and terminates the program. `outOfMemHook` can @@ -1965,7 +1971,7 @@ elif hostOS != "standalone": inc(i) {.pop.} -proc echo*[T](x: varargs[T, `$`]) {.magic: "Echo", tags: [FWriteIO].} +proc echo*[T](x: varargs[T, `$`]) {.magic: "Echo", tags: [FWriteIO], gcsafe.} ## special built-in that takes a variable number of arguments. Each argument ## is converted to a string via ``$``, so it works for user-defined ## types that have an overloaded ``$`` operator. @@ -2119,14 +2125,15 @@ when not defined(JS): #and not defined(NimrodVM): ## `useStdoutAsStdmsg` compile-time switch. proc open*(f: var TFile, filename: string, - mode: TFileMode = fmRead, bufSize: int = -1): bool {.tags: [].} + mode: TFileMode = fmRead, bufSize: int = -1): bool {.tags: [], + gcsafe.} ## Opens a file named `filename` with given `mode`. ## ## Default mode is readonly. Returns true iff the file could be opened. ## This throws no exception if the file could not be opened. proc open*(f: var TFile, filehandle: TFileHandle, - mode: TFileMode = fmRead): bool {.tags: [].} + mode: TFileMode = fmRead): bool {.tags: [], gcsafe.} ## Creates a ``TFile`` from a `filehandle` with given `mode`. ## ## Default mode is readonly. Returns true iff the file could be opened. @@ -2141,7 +2148,7 @@ when not defined(JS): #and not defined(NimrodVM): sysFatal(EIO, "cannot open: ", filename) proc reopen*(f: TFile, filename: string, mode: TFileMode = fmRead): bool {. - tags: [].} + tags: [], gcsafe.} ## reopens the file `f` with given `filename` and `mode`. This ## is often used to redirect the `stdin`, `stdout` or `stderr` ## file variables. @@ -2151,7 +2158,7 @@ when not defined(JS): #and not defined(NimrodVM): proc close*(f: TFile) {.importc: "fclose", header: "", tags: [].} ## Closes the file. - proc endOfFile*(f: TFile): bool {.tags: [].} + proc endOfFile*(f: TFile): bool {.tags: [], gcsafe.} ## Returns true iff `f` is at the end. proc readChar*(f: TFile): char {. @@ -2161,39 +2168,40 @@ when not defined(JS): #and not defined(NimrodVM): importc: "fflush", header: "", tags: [FWriteIO].} ## Flushes `f`'s buffer. - proc readAll*(file: TFile): TaintedString {.tags: [FReadIO].} + proc readAll*(file: TFile): TaintedString {.tags: [FReadIO], gcsafe.} ## Reads all data from the stream `file`. ## ## Raises an IO exception in case of an error. It is an error if the ## current file position is not at the beginning of the file. - proc readFile*(filename: string): TaintedString {.tags: [FReadIO].} + proc readFile*(filename: string): TaintedString {.tags: [FReadIO], gcsafe.} ## Opens a file named `filename` for reading. Then calls `readAll` ## and closes the file afterwards. Returns the string. ## Raises an IO exception in case of an error. - proc writeFile*(filename, content: string) {.tags: [FWriteIO].} + proc writeFile*(filename, content: string) {.tags: [FWriteIO], gcsafe.} ## Opens a file named `filename` for writing. Then writes the ## `content` completely to the file and closes the file afterwards. ## Raises an IO exception in case of an error. - proc write*(f: TFile, r: float32) {.tags: [FWriteIO].} - proc write*(f: TFile, i: int) {.tags: [FWriteIO].} - proc write*(f: TFile, i: BiggestInt) {.tags: [FWriteIO].} - proc write*(f: TFile, r: BiggestFloat) {.tags: [FWriteIO].} - proc write*(f: TFile, s: string) {.tags: [FWriteIO].} - proc write*(f: TFile, b: bool) {.tags: [FWriteIO].} - proc write*(f: TFile, c: char) {.tags: [FWriteIO].} - proc write*(f: TFile, c: cstring) {.tags: [FWriteIO].} - proc write*(f: TFile, a: varargs[string, `$`]) {.tags: [FWriteIO].} + proc write*(f: TFile, r: float32) {.tags: [FWriteIO], gcsafe.} + proc write*(f: TFile, i: int) {.tags: [FWriteIO], gcsafe.} + proc write*(f: TFile, i: BiggestInt) {.tags: [FWriteIO], gcsafe.} + proc write*(f: TFile, r: BiggestFloat) {.tags: [FWriteIO], gcsafe.} + proc write*(f: TFile, s: string) {.tags: [FWriteIO], gcsafe.} + proc write*(f: TFile, b: bool) {.tags: [FWriteIO], gcsafe.} + proc write*(f: TFile, c: char) {.tags: [FWriteIO], gcsafe.} + proc write*(f: TFile, c: cstring) {.tags: [FWriteIO], gcsafe.} + proc write*(f: TFile, a: varargs[string, `$`]) {.tags: [FWriteIO], gcsafe.} ## Writes a value to the file `f`. May throw an IO exception. - proc readLine*(f: TFile): TaintedString {.tags: [FReadIO].} + proc readLine*(f: TFile): TaintedString {.tags: [FReadIO], gcsafe.} ## reads a line of text from the file `f`. May throw an IO exception. ## A line of text may be delimited by ``CR``, ``LF`` or ## ``CRLF``. The newline character(s) are not part of the returned string. - proc readLine*(f: TFile, line: var TaintedString): bool {.tags: [FReadIO].} + proc readLine*(f: TFile, line: var TaintedString): bool {.tags: [FReadIO], + gcsafe.} ## reads a line of text from the file `f` into `line`. `line` must not be ## ``nil``! May throw an IO exception. ## A line of text may be delimited by ``CR``, ``LF`` or @@ -2201,53 +2209,55 @@ when not defined(JS): #and not defined(NimrodVM): ## Returns ``false`` if the end of the file has been reached, ``true`` ## otherwise. If ``false`` is returned `line` contains no new data. - proc writeln*[Ty](f: TFile, x: varargs[Ty, `$`]) {.inline, tags: [FWriteIO].} + proc writeln*[Ty](f: TFile, x: varargs[Ty, `$`]) {.inline, + tags: [FWriteIO], gcsafe.} ## writes the values `x` to `f` and then writes "\n". ## May throw an IO exception. - proc getFileSize*(f: TFile): int64 {.tags: [FReadIO].} + proc getFileSize*(f: TFile): int64 {.tags: [FReadIO], gcsafe.} ## retrieves the file size (in bytes) of `f`. proc readBytes*(f: TFile, a: var openArray[int8], start, len: int): int {. - tags: [FReadIO].} + tags: [FReadIO], gcsafe.} ## reads `len` bytes into the buffer `a` starting at ``a[start]``. Returns ## the actual number of bytes that have been read which may be less than ## `len` (if not as many bytes are remaining), but not greater. proc readChars*(f: TFile, a: var openArray[char], start, len: int): int {. - tags: [FReadIO].} + tags: [FReadIO], gcsafe.} ## reads `len` bytes into the buffer `a` starting at ``a[start]``. Returns ## the actual number of bytes that have been read which may be less than ## `len` (if not as many bytes are remaining), but not greater. - proc readBuffer*(f: TFile, buffer: pointer, len: int): int {.tags: [FReadIO].} + proc readBuffer*(f: TFile, buffer: pointer, len: int): int {. + tags: [FReadIO], gcsafe.} ## reads `len` bytes into the buffer pointed to by `buffer`. Returns ## the actual number of bytes that have been read which may be less than ## `len` (if not as many bytes are remaining), but not greater. proc writeBytes*(f: TFile, a: openArray[int8], start, len: int): int {. - tags: [FWriteIO].} + tags: [FWriteIO], gcsafe.} ## writes the bytes of ``a[start..start+len-1]`` to the file `f`. Returns ## the number of actual written bytes, which may be less than `len` in case ## of an error. proc writeChars*(f: TFile, a: openArray[char], start, len: int): int {. - tags: [FWriteIO].} + tags: [FWriteIO], gcsafe.} ## writes the bytes of ``a[start..start+len-1]`` to the file `f`. Returns ## the number of actual written bytes, which may be less than `len` in case ## of an error. proc writeBuffer*(f: TFile, buffer: pointer, len: int): int {. - tags: [FWriteIO].} + tags: [FWriteIO], gcsafe.} ## writes the bytes of buffer pointed to by the parameter `buffer` to the ## file `f`. Returns the number of actual written bytes, which may be less ## than `len` in case of an error. - proc setFilePos*(f: TFile, pos: int64) + proc setFilePos*(f: TFile, pos: int64) {.gcsafe.} ## sets the position of the file pointer that is used for read/write ## operations. The file's first byte has the index zero. - proc getFilePos*(f: TFile): int64 + proc getFilePos*(f: TFile): int64 {.gcsafe.} ## retrieves the current position of the file pointer that is used to ## read from the file `f`. The file's first byte has the index zero. @@ -2290,10 +2300,12 @@ when not defined(JS): #and not defined(NimrodVM): dealloc(a) when not defined(NimrodVM): - proc atomicInc*(memLoc: var int, x: int = 1): int {.inline, discardable.} + proc atomicInc*(memLoc: var int, x: int = 1): int {.inline, + discardable, gcsafe.} ## atomic increment of `memLoc`. Returns the value after the operation. - proc atomicDec*(memLoc: var int, x: int = 1): int {.inline, discardable.} + proc atomicDec*(memLoc: var int, x: int = 1): int {.inline, + discardable, gcsafe.} ## atomic decrement of `memLoc`. Returns the value after the operation. include "system/atomics" diff --git a/lib/system/avltree.nim b/lib/system/avltree.nim index fc965d6aaa..bced15d6a6 100644 --- a/lib/system/avltree.nim +++ b/lib/system/avltree.nim @@ -51,7 +51,7 @@ proc split(t: var PAvlNode) = t.link[0] = temp inc t.level -proc add(a: var TMemRegion, t: var PAvlNode, key, upperBound: int) = +proc add(a: var TMemRegion, t: var PAvlNode, key, upperBound: int) {.gcsafe.} = if t == bottom: t = allocAvlNode(a, key, upperBound) else: @@ -64,7 +64,7 @@ proc add(a: var TMemRegion, t: var PAvlNode, key, upperBound: int) = skew(t) split(t) -proc del(a: var TMemRegion, t: var PAvlNode, x: int) = +proc del(a: var TMemRegion, t: var PAvlNode, x: int) {.gcsafe.} = if t == bottom: return a.last = t if x <% t.key: diff --git a/lib/system/cgprocs.nim b/lib/system/cgprocs.nim index e30cfa4698..d483c61bda 100644 --- a/lib/system/cgprocs.nim +++ b/lib/system/cgprocs.nim @@ -9,7 +9,7 @@ # Headers for procs that the code generator depends on ("compilerprocs") -proc addChar(s: NimString, c: char): NimString {.compilerProc.} +proc addChar(s: NimString, c: char): NimString {.compilerProc, gcsafe.} type TLibHandle = pointer # private type @@ -21,5 +21,5 @@ proc nimGetProcAddr(lib: TLibHandle, name: cstring): TProcAddr {.compilerproc.} proc nimLoadLibraryError(path: string) {.compilerproc, noinline.} -proc setStackBottom(theStackBottom: pointer) {.compilerRtl, noinline.} +proc setStackBottom(theStackBottom: pointer) {.compilerRtl, noinline, gcsafe.} diff --git a/lib/system/excpt.nim b/lib/system/excpt.nim index e50ba7b9fa..612a9e729f 100644 --- a/lib/system/excpt.nim +++ b/lib/system/excpt.nim @@ -11,7 +11,7 @@ # use the heap (and nor exceptions) do not include the GC or memory allocator. var - errorMessageWriter*: (proc(msg: string) {.tags: [FWriteIO].}) + errorMessageWriter*: (proc(msg: string) {.tags: [FWriteIO], gcsafe.}) ## Function that will be called ## instead of stdmsg.write when printing stacktrace. ## Unstable API. @@ -32,10 +32,10 @@ proc showErrorMessage(data: cstring) = else: writeToStdErr(data) -proc chckIndx(i, a, b: int): int {.inline, compilerproc.} -proc chckRange(i, a, b: int): int {.inline, compilerproc.} -proc chckRangeF(x, a, b: float): float {.inline, compilerproc.} -proc chckNil(p: pointer) {.noinline, compilerproc.} +proc chckIndx(i, a, b: int): int {.inline, compilerproc, gcsafe.} +proc chckRange(i, a, b: int): int {.inline, compilerproc, gcsafe.} +proc chckRangeF(x, a, b: float): float {.inline, compilerproc, gcsafe.} +proc chckNil(p: pointer) {.noinline, compilerproc, gcsafe.} var framePtr {.rtlThreadVar.}: PFrame @@ -322,5 +322,5 @@ when not defined(noSignalHandler): proc setControlCHook(hook: proc () {.noconv.}) = # ugly cast, but should work on all architectures: - type TSignalHandler = proc (sig: cint) {.noconv.} + type TSignalHandler = proc (sig: cint) {.noconv, gcsafe.} c_signal(SIGINT, cast[TSignalHandler](hook)) diff --git a/lib/system/gc.nim b/lib/system/gc.nim index ec17609148..3b85fe6002 100644 --- a/lib/system/gc.nim +++ b/lib/system/gc.nim @@ -51,7 +51,7 @@ type waZctDecRef, waPush, waCycleDecRef, waMarkGray, waScan, waScanBlack, waCollectWhite, - TFinalizer {.compilerproc.} = proc (self: pointer) {.nimcall.} + TFinalizer {.compilerproc.} = proc (self: pointer) {.nimcall, gcsafe.} # A ref type can have a finalizer that is called before the object's # storage is freed. @@ -152,11 +152,11 @@ template gcTrace(cell, state: expr): stmt {.immediate.} = when traceGC: traceCell(cell, state) # forward declarations: -proc collectCT(gch: var TGcHeap) -proc isOnStack*(p: pointer): bool {.noinline.} -proc forAllChildren(cell: PCell, op: TWalkOp) -proc doOperation(p: pointer, op: TWalkOp) -proc forAllChildrenAux(dest: pointer, mt: PNimType, op: TWalkOp) +proc collectCT(gch: var TGcHeap) {.gcsafe.} +proc isOnStack*(p: pointer): bool {.noinline, gcsafe.} +proc forAllChildren(cell: PCell, op: TWalkOp) {.gcsafe.} +proc doOperation(p: pointer, op: TWalkOp) {.gcsafe.} +proc forAllChildrenAux(dest: pointer, mt: PNimType, op: TWalkOp) {.gcsafe.} # we need the prototype here for debugging purposes when hasThreadSupport and hasSharedHeap: @@ -294,7 +294,7 @@ proc initGC() = when useMarkForDebug or useBackupGc: type - TGlobalMarkerProc = proc () {.nimcall.} + TGlobalMarkerProc = proc () {.nimcall, gcsafe.} var globalMarkersLen: int globalMarkers: array[0.. 7_000, TGlobalMarkerProc] @@ -311,7 +311,7 @@ proc cellsetReset(s: var TCellSet) = deinit(s) init(s) -proc forAllSlotsAux(dest: pointer, n: ptr TNimNode, op: TWalkOp) = +proc forAllSlotsAux(dest: pointer, n: ptr TNimNode, op: TWalkOp) {.gcsafe.} = var d = cast[TAddress](dest) case n.kind of nkSlot: forAllChildrenAux(cast[pointer](d +% n.offset), n.typ, op) @@ -680,10 +680,11 @@ proc doOperation(p: pointer, op: TWalkOp) = proc nimGCvisit(d: pointer, op: int) {.compilerRtl.} = doOperation(d, TWalkOp(op)) -proc collectZCT(gch: var TGcHeap): bool +proc collectZCT(gch: var TGcHeap): bool {.gcsafe.} when useMarkForDebug or useBackupGc: - proc markStackAndRegistersForSweep(gch: var TGcHeap) {.noinline, cdecl.} + proc markStackAndRegistersForSweep(gch: var TGcHeap) {.noinline, cdecl, + gcsafe.} proc collectRoots(gch: var TGcHeap) = for s in elements(gch.cycleRoots): diff --git a/lib/system/hti.nim b/lib/system/hti.nim index 9d8ece7df6..64174e60f1 100644 --- a/lib/system/hti.nim +++ b/lib/system/hti.nim @@ -85,7 +85,7 @@ type base: ptr TNimType node: ptr TNimNode # valid for tyRecord, tyObject, tyTuple, tyEnum finalizer: pointer # the finalizer for the type - marker: proc (p: pointer, op: int) {.nimcall.} # marker proc for GC + marker: proc (p: pointer, op: int) {.nimcall, gcsafe.} # marker proc for GC PNimType = ptr TNimType # node.len may be the ``first`` element of a set diff --git a/lib/system/syslocks.nim b/lib/system/syslocks.nim index 5e3b04b7f1..b8ed29cfc6 100644 --- a/lib/system/syslocks.nim +++ b/lib/system/syslocks.nim @@ -52,7 +52,7 @@ when defined(Windows): proc closeHandle(hObject: THandle) {.stdcall, noSideEffect, dynlib: "kernel32", importc: "CloseHandle".} proc waitForSingleObject(hHandle: THandle, dwMilliseconds: int32): int32 {. - stdcall, dynlib: "kernel32", importc: "WaitForSingleObject".} + stdcall, dynlib: "kernel32", importc: "WaitForSingleObject", noSideEffect.} proc signalSysCond(hEvent: TSysCond) {.stdcall, noSideEffect, dynlib: "kernel32", importc: "SetEvent".} @@ -89,16 +89,16 @@ else: proc releaseSys(L: var TSysLock) {.noSideEffect, importc: "pthread_mutex_unlock", header: "".} - proc deinitSys(L: var TSysLock) {. + proc deinitSys(L: var TSysLock) {.noSideEffect, importc: "pthread_mutex_destroy", header: "".} proc initSysCond(cond: var TSysCond, cond_attr: pointer = nil) {. - importc: "pthread_cond_init", header: "".} + importc: "pthread_cond_init", header: "", noSideEffect.} proc waitSysCond(cond: var TSysCond, lock: var TSysLock) {. - importc: "pthread_cond_wait", header: "".} + importc: "pthread_cond_wait", header: "", noSideEffect.} proc signalSysCond(cond: var TSysCond) {. - importc: "pthread_cond_signal", header: "".} + importc: "pthread_cond_signal", header: "", noSideEffect.} - proc deinitSysCond(cond: var TSysCond) {. + proc deinitSysCond(cond: var TSysCond) {.noSideEffect, importc: "pthread_cond_destroy", header: "".} diff --git a/lib/system/sysspawn.nim b/lib/system/sysspawn.nim new file mode 100644 index 0000000000..3a641aba6a --- /dev/null +++ b/lib/system/sysspawn.nim @@ -0,0 +1,172 @@ +# Implements Nimrod's 'spawn'. + +{.push stackTrace:off.} +include system.syslocks + +when (defined(x86) or defined(amd64)) and defined(gcc): + proc cpuRelax {.inline.} = + {.emit: """asm volatile("pause" ::: "memory");""".} +elif (defined(x86) or defined(amd64)) and defined(vcc): + proc cpuRelax {.importc: "YieldProcessor", header: "".} +elif defined(intelc): + proc cpuRelax {.importc: "_mm_pause", header: "xmmintrin.h".} +else: + from os import sleep + + proc cpuRelax {.inline.} = os.sleep(1) + +when defined(windows): + proc interlockedCompareExchange(p: pointer; exchange, comparand: int32): int32 + {.importc: "InterlockedCompareExchange", header: "", cdecl.} + + proc cas(p: ptr bool; oldValue, newValue: bool): bool = + interlockedCompareExchange(p, newValue.int32, oldValue.int32) != 0 + +else: + # this is valid for GCC and Intel C++ + proc cas(p: ptr bool; oldValue, newValue: bool): bool + {.importc: "__sync_bool_compare_and_swap", nodecl.} + +# We declare our own condition variables here to get rid of the dummy lock +# on Windows: + +type + CondVar = object + c: TSysCond + when defined(posix): + stupidLock: TSysLock + +proc createCondVar(): CondVar = + initSysCond(result.c) + when defined(posix): + initSysLock(result.stupidLock) + acquireSys(result.stupidLock) + +proc await(cv: var CondVar) = + when defined(posix): + waitSysCond(cv.c, cv.stupidLock) + else: + waitSysCondWindows(cv.c) + +proc signal(cv: var CondVar) = signalSysCond(cv.c) + +type + FastCondVar = object + event, slowPath: bool + slow: CondVar + +proc createFastCondVar(): FastCondVar = + initSysCond(result.slow.c) + when defined(posix): + initSysLock(result.slow.stupidLock) + acquireSys(result.slow.stupidLock) + result.event = false + result.slowPath = false + +proc await(cv: var FastCondVar) = + #for i in 0 .. 50: + # if cas(addr cv.event, true, false): + # # this is a HIT: Triggers > 95% in my tests. + # return + # cpuRelax() + #cv.slowPath = true + await(cv.slow) + cv.event = false + +proc signal(cv: var FastCondVar) = + cv.event = true + #if cas(addr cv.slowPath, true, false): + signal(cv.slow) + +{.pop.} + +# ---------------------------------------------------------------------------- + +type + WorkerProc = proc (thread, args: pointer) {.nimcall, gcsafe.} + Worker = object + taskArrived: CondVar + taskStarted: FastCondVar #\ + # task data: + f: WorkerProc + data: pointer + ready: bool # put it here for correct alignment! + +proc nimArgsPassingDone(p: pointer) {.compilerProc.} = + let w = cast[ptr Worker](p) + signal(w.taskStarted) + +var gSomeReady = createFastCondVar() + +proc slave(w: ptr Worker) {.thread.} = + while true: + w.ready = true # If we instead signal "workerReady" we need the scheduler + # to notice this. The scheduler could then optimize the + # layout of the worker threads (e.g. keep the list sorted) + # so that no search for a "ready" thread is necessary. + # This might be implemented later, but is more tricky than + # it looks because 'spawn' itself can run concurrently. + signal(gSomeReady) + await(w.taskArrived) + assert(not w.ready) + if w.data != nil: + w.f(w, w.data) + w.data = nil + +const NumThreads = 4 + +var + workers: array[NumThreads, TThread[ptr Worker]] + workersData: array[NumThreads, Worker] + +proc setup() = + for i in 0..