jyapayne/Nim
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

version 0.7.8

Browse source
This commit is contained in:
Andreas Rumpf 2009-05-08 16:36:06 +02:00
commit db4f617afc
92 changed files with 3088 additions and 3477 deletions
Download patch file Download diff file Expand all files Collapse all files

217
lib/alloc.nim
View file

@ -7,29 +7,27 @@
# distribution, for details about the copyright.
#
# Low level allocator for Nimrod.
# Low level allocator for Nimrod. Has been designed to support the GC.
# TODO:
# - eliminate "used" field
# - make searching for block O(1)
proc raiseOutOfMem {.noinline.} =
assert false
quit(1)
# ------------ platform specific chunk allocation code -----------------------
when defined(posix):
const # XXX: make these variables for portability?
const
PROT_READ = 1 # page can be read
PROT_WRITE = 2 # page can be written
MAP_PRIVATE = 2 # Changes are private
when defined(linux):
when defined(linux) or defined(aix):
const MAP_ANONYMOUS = 0x20 # don't use a file
elif defined(macosx):
elif defined(macosx) or defined(bsd):
const MAP_ANONYMOUS = 0x1000
elif defined(solaris):
const MAP_ANONYMOUS = 0x100
else:
const MAP_ANONYMOUS = 0 # other operating systems may not know about this
{.error: "Port memory manager to your platform".}
proc mmap(adr: pointer, len: int, prot, flags, fildes: cint,
off: int): pointer {.header: "<sys/mman.h>".}
@ -43,7 +41,7 @@ when defined(posix):
raiseOutOfMem()
proc osDeallocPages(p: pointer, size: int) {.inline} =
munmap(p, size)
when reallyOsDealloc: munmap(p, size)
elif defined(windows):
const
@ -69,7 +67,7 @@ elif defined(windows):
proc osDeallocPages(p: pointer, size: int) {.inline.} =
# according to Microsoft, 0 is the only correct value here:
VirtualFree(p, 0, MEM_RELEASE)
when reallyOsDealloc: VirtualFree(p, 0, MEM_RELEASE)
else:
{.error: "Port memory manager to your platform".}
@ -77,48 +75,14 @@ else:
# --------------------- end of non-portable code -----------------------------
# We manage *chunks* of memory. Each chunk is a multiple of the page size.
# The page size may or may not the operating system's page size. Each chunk
# starts at an address that is divisible by the page size. Chunks that are
# bigger than ``ChunkOsReturn`` are returned back to the operating system
# immediately.
# Guess the page size of the system; if it is the
# wrong value, performance may be worse (this is not
# for sure though), but GC still works; must be a power of two!
when defined(linux) or defined(windows) or defined(macosx):
const
PageShift = 12
PageSize = 1 shl PageShift # on 32 bit systems 4096
else:
{.error: "unkown page size".}
# Each chunk starts at an address that is divisible by the page size. Chunks
# that are bigger than ``ChunkOsReturn`` are returned back to the operating
# system immediately.
const
PageMask = PageSize-1
SmallChunkSize = PageSize # * 4
MemAlign = 8 # minimal memory block that can be allocated
BitsPerPage = PageSize div MemAlign
UnitsPerPage = BitsPerPage div (sizeof(int)*8)
# how many ints do we need to describe a page:
# on 32 bit systems this is only 16 (!)
ChunkOsReturn = 64 * PageSize
ChunkOsReturn = 256 * PageSize
InitialMemoryRequest = ChunkOsReturn div 2 # < ChunkOsReturn!
# Compile time options:
coalescRight = true
coalescLeft = true
const
TrunkShift = 9
BitsPerTrunk = 1 shl TrunkShift # needs to be a power of 2 and divisible by 64
TrunkMask = BitsPerTrunk - 1
IntsPerTrunk = BitsPerTrunk div (sizeof(int)*8)
IntShift = 5 + ord(sizeof(int) == 8) # 5 or 6, depending on int width
IntMask = 1 shl IntShift - 1
SmallChunkSize = PageSize
type
PTrunk = ptr TTrunk
@ -132,10 +96,11 @@ type
data: TTrunkBuckets
type
TAlignType = float
TAlignType = biggestFloat
TFreeCell {.final, pure.} = object
next: ptr TFreeCell # next free cell in chunk (overlaid with refcount)
zeroField: pointer # nil means cell is not used (overlaid with typ field)
zeroField: int # 0 means cell is not used (overlaid with typ field)
# 1 means cell is manually managed pointer
PChunk = ptr TBaseChunk
PBigChunk = ptr TBigChunk
@ -155,15 +120,20 @@ type
TBigChunk = object of TBaseChunk # not necessarily > PageSize!
next: PBigChunk # chunks of the same (or bigger) size
prev: PBigChunk
align: int
data: TAlignType # start of usable memory
template smallChunkOverhead(): expr = sizeof(TSmallChunk)-sizeof(TAlignType)
template bigChunkOverhead(): expr = sizeof(TBigChunk)-sizeof(TAlignType)
proc roundup(x, v: int): int {.inline.} = return ((-x) and (v-1)) +% x
proc roundup(x, v: int): int {.inline.} =
result = (x + (v-1)) and not (v-1)
assert(result >= x)
#return ((-x) and (v-1)) +% x
assert(roundup(14, PageSize) == PageSize)
assert(roundup(15, 8) == 16)
assert(roundup(65, 8) == 72)
# ------------- chunk table ---------------------------------------------------
# We use a PtrSet of chunk starts and a table[Page, chunksize] for chunk
@ -180,7 +150,7 @@ type
TAllocator {.final, pure.} = object
llmem: PLLChunk
currMem, maxMem: int # currently and maximum used memory size (allocated from OS)
currMem, maxMem, freeMem: int # memory sizes (allocated from OS)
freeSmallChunks: array[0..SmallChunkSize div MemAlign-1, PSmallChunk]
freeChunksList: PBigChunk # XXX make this a datastructure with O(1) access
chunkStarts: TIntSet
@ -277,8 +247,10 @@ var lastSize = PageSize
proc requestOsChunks(a: var TAllocator, size: int): PBigChunk =
incCurrMem(a, size)
inc(a.freeMem, size)
result = cast[PBigChunk](osAllocPages(size))
assert((cast[TAddress](result) and PageMask) == 0)
#zeroMem(result, size)
result.next = nil
result.prev = nil
result.used = false
@ -312,11 +284,28 @@ proc freeOsChunks(a: var TAllocator, p: pointer, size: int) =
excl(a.chunkStarts, pageIndex(p))
osDeallocPages(p, size)
decCurrMem(a, size)
dec(a.freeMem, size)
#c_fprintf(c_stdout, "[Alloc] back to OS: %ld\n", size)
proc isAccessible(p: pointer): bool {.inline.} =
result = Contains(allocator.chunkStarts, pageIndex(p))
proc contains[T](list, x: T): bool =
var it = list
while it != nil:
if it == x: return true
it = it.next
proc writeFreeList(a: TAllocator) =
var it = a.freeChunksList
c_fprintf(c_stdout, "freeChunksList: %p\n", it)
while it != nil:
c_fprintf(c_stdout, "it: %p, next: %p, prev: %p\n",
it, it.next, it.prev)
it = it.next
proc ListAdd[T](head: var T, c: T) {.inline.} =
assert(c notin head)
assert c.prev == nil
assert c.next == nil
c.next = head
@ -326,6 +315,7 @@ proc ListAdd[T](head: var T, c: T) {.inline.} =
head = c
proc ListRemove[T](head: var T, c: T) {.inline.} =
assert(c in head)
if c == head:
head = c.next
assert c.prev == nil
@ -344,13 +334,22 @@ proc isSmallChunk(c: PChunk): bool {.inline.} =
proc chunkUnused(c: PChunk): bool {.inline.} =
result = not c.used
proc updatePrevSize(a: var TAllocator, c: PBigChunk,
prevSize: int) {.inline.} =
var ri = cast[PChunk](cast[TAddress](c) +% c.size)
assert((cast[TAddress](ri) and PageMask) == 0)
if isAccessible(ri):
ri.prevSize = prevSize
proc freeBigChunk(a: var TAllocator, c: PBigChunk) =
var c = c
assert(c.size >= PageSize)
inc(a.freeMem, c.size)
when coalescRight:
var ri = cast[PChunk](cast[TAddress](c) +% c.size)
assert((cast[TAddress](ri) and PageMask) == 0)
if isAccessible(ri) and chunkUnused(ri):
assert(not isSmallChunk(ri))
if not isSmallChunk(ri):
ListRemove(a.freeChunksList, cast[PBigChunk](ri))
inc(c.size, ri.size)
@ -360,6 +359,7 @@ proc freeBigChunk(a: var TAllocator, c: PBigChunk) =
var le = cast[PChunk](cast[TAddress](c) -% c.prevSize)
assert((cast[TAddress](le) and PageMask) == 0)
if isAccessible(le) and chunkUnused(le):
assert(not isSmallChunk(le))
if not isSmallChunk(le):
ListRemove(a.freeChunksList, cast[PBigChunk](le))
inc(le.size, c.size)
@ -367,6 +367,8 @@ proc freeBigChunk(a: var TAllocator, c: PBigChunk) =
c = cast[PBigChunk](le)
if c.size < ChunkOsReturn:
incl(a.chunkStarts, pageIndex(c))
updatePrevSize(a, c, c.size)
ListAdd(a.freeChunksList, c)
c.used = false
else:
@ -374,11 +376,16 @@ proc freeBigChunk(a: var TAllocator, c: PBigChunk) =
proc splitChunk(a: var TAllocator, c: PBigChunk, size: int) =
var rest = cast[PBigChunk](cast[TAddress](c) +% size)
if rest in a.freeChunksList:
c_fprintf(c_stdout, "to add: %p\n", rest)
writeFreeList(allocator)
assert false
rest.size = c.size - size
rest.used = false
rest.next = nil # XXX
rest.next = nil
rest.prev = nil
rest.prevSize = size
updatePrevSize(a, c, rest.size)
c.size = size
incl(a.chunkStarts, pageIndex(rest))
ListAdd(a.freeChunksList, rest)
@ -386,26 +393,32 @@ proc splitChunk(a: var TAllocator, c: PBigChunk, size: int) =
proc getBigChunk(a: var TAllocator, size: int): PBigChunk =
# use first fit for now:
assert((size and PageMask) == 0)
assert(size > 0)
result = a.freeChunksList
block search:
while result != nil:
#if not chunkUnused(result):
# c_fprintf(c_stdout, "%lld\n", int(result.used))
assert chunkUnused(result)
if result.size == size:
ListRemove(a.freeChunksList, result)
break search
elif result.size > size:
splitChunk(a, result, size)
#c_fprintf(c_stdout, "res size: %lld; size: %lld\n", result.size, size)
ListRemove(a.freeChunksList, result)
splitChunk(a, result, size)
break search
result = result.next
assert result != a.freeChunksList
if size < InitialMemoryRequest:
result = requestOsChunks(a, InitialMemoryRequest)
splitChunk(a, result, size)
else:
result = requestOsChunks(a, size)
result.prevSize = 0
result.prevSize = 0 # XXX why is this needed?
result.used = true
incl(a.chunkStarts, pageIndex(result))
dec(a.freeMem, size)
proc getSmallChunk(a: var TAllocator): PSmallChunk =
var res = getBigChunk(a, PageSize)
@ -419,8 +432,11 @@ proc getCellSize(p: pointer): int {.inline.} =
var c = pageAddr(p)
result = c.size
proc alloc(a: var TAllocator, requestedSize: int): pointer =
var size = roundup(max(requestedSize, sizeof(TFreeCell)), MemAlign)
proc rawAlloc(a: var TAllocator, requestedSize: int): pointer =
assert(roundup(65, 8) == 72)
assert requestedSize >= sizeof(TFreeCell)
var size = roundup(requestedSize, MemAlign)
#c_fprintf(c_stdout, "alloc; size: %ld; %ld\n", requestedSize, size)
if size <= SmallChunkSize-smallChunkOverhead():
# allocate a small block: for small chunks, we use only its next pointer
var s = size div MemAlign
@ -436,8 +452,11 @@ proc alloc(a: var TAllocator, requestedSize: int): pointer =
c.prev = nil
ListAdd(a.freeSmallChunks[s], c)
result = addr(c.data)
assert((cast[TAddress](result) and (MemAlign-1)) == 0)
else:
assert c.next != c
#if c.size != size:
# c_fprintf(c_stdout, "csize: %lld; size %lld\n", c.size, size)
assert c.size == size
if c.freeList == nil:
assert(c.acc + smallChunkOverhead() + size <= SmallChunkSize)
@ -445,9 +464,10 @@ proc alloc(a: var TAllocator, requestedSize: int): pointer =
inc(c.acc, size)
else:
result = c.freeList
assert(c.freeList.zeroField == nil)
assert(c.freeList.zeroField == 0)
c.freeList = c.freeList.next
dec(c.free, size)
assert((cast[TAddress](result) and (MemAlign-1)) == 0)
if c.free < size:
ListRemove(a.freeSmallChunks[s], c)
else:
@ -458,16 +478,10 @@ proc alloc(a: var TAllocator, requestedSize: int): pointer =
assert c.next == nil
assert c.size == size
result = addr(c.data)
cast[ptr TFreeCell](result).zeroField = cast[ptr TFreeCell](1) # make it != nil
#echo("setting to one: ", $cast[TAddress](addr(cast[ptr TFreeCell](result).zeroField)))
assert((cast[TAddress](result) and (MemAlign-1)) == 0)
assert(isAccessible(result))
proc contains(list, x: PSmallChunk): bool =
var it = list
while it != nil:
if it == x: return true
it = it.next
proc dealloc(a: var TAllocator, p: pointer) =
proc rawDealloc(a: var TAllocator, p: pointer) =
var c = pageAddr(p)
if isSmallChunk(c):
# `p` is within a small chunk:
@ -475,8 +489,8 @@ proc dealloc(a: var TAllocator, p: pointer) =
var s = c.size
var f = cast[ptr TFreeCell](p)
#echo("setting to nil: ", $cast[TAddress](addr(f.zeroField)))
assert(f.zeroField != nil)
f.zeroField = nil
assert(f.zeroField != 0)
f.zeroField = 0
f.next = c.freeList
c.freeList = f
# check if it is not in the freeSmallChunks[s] list:
@ -495,23 +509,64 @@ proc dealloc(a: var TAllocator, p: pointer) =
# free big chunk
freeBigChunk(a, cast[PBigChunk](c))
proc realloc(a: var TAllocator, p: pointer, size: int): pointer =
# could be made faster, but this is unnecessary, the GC does not use it anyway
result = alloc(a, size)
copyMem(result, p, getCellSize(p))
dealloc(a, p)
proc isAllocatedPtr(a: TAllocator, p: pointer): bool =
if isAccessible(p):
var c = pageAddr(p)
if not chunkUnused(c):
if isSmallChunk(c):
result = (cast[TAddress](p) -% cast[TAddress](c) -%
smallChunkOverhead()) %% c.size == 0 and
cast[ptr TFreeCell](p).zeroField != nil
var c = cast[PSmallChunk](c)
var offset = (cast[TAddress](p) and (PageSize-1)) -%
smallChunkOverhead()
result = (c.acc >% offset) and (offset %% c.size == 0) and
(cast[ptr TFreeCell](p).zeroField >% 1)
else:
var c = cast[PBigChunk](c)
result = p == addr(c.data)
result = p == addr(c.data) and cast[ptr TFreeCell](p).zeroField >% 1
# ---------------------- interface to programs -------------------------------
proc alloc(size: int): pointer =
result = rawAlloc(allocator, size+sizeof(TFreeCell))
cast[ptr TFreeCell](result).zeroField = 1 # mark it as used
assert(not isAllocatedPtr(allocator, result))
result = cast[pointer](cast[TAddress](result) +% sizeof(TFreeCell))
proc alloc0(size: int): pointer =
result = alloc(size)
zeroMem(result, size)
proc dealloc(p: pointer) =
var x = cast[pointer](cast[TAddress](p) -% sizeof(TFreeCell))
assert(cast[ptr TFreeCell](x).zeroField == 1)
rawDealloc(allocator, x)
assert(not isAllocatedPtr(allocator, x))
proc ptrSize(p: pointer): int =
var x = cast[pointer](cast[TAddress](p) -% sizeof(TFreeCell))
result = pageAddr(x).size - sizeof(TFreeCell)
proc realloc(p: pointer, newsize: int): pointer =
if newsize > 0:
result = alloc(newsize)
if p != nil:
copyMem(result, p, ptrSize(p))
dealloc(p)
elif p != nil:
dealloc(p)
proc countFreeMem(): int =
# only used for assertions
var it = allocator.freeChunksList
while it != nil:
inc(result, it.size)
it = it.next
proc getFreeMem(): int =
result = allocator.freeMem
#assert(result == countFreeMem())
proc getTotalMem(): int = return allocator.currMem
proc getOccupiedMem(): int = return getTotalMem() - getFreeMem()
when isMainModule:
const iterations = 4000_000

6
lib/ansi_c.nim
View file

@ -1,7 +1,7 @@
#
#
# Nimrod's Runtime Library
# (c) Copyright 2006 Andreas Rumpf
# (c) Copyright 2009 Andreas Rumpf
#
# See the file "copying.txt", included in this
# distribution, for details about the copyright.
@ -82,3 +82,7 @@ proc c_ferror(stream: C_TextFileStar): bool {.importc: "ferror", nodecl.}
proc c_fflush(stream: C_TextFileStar) {.importc: "fflush", nodecl.}
proc c_abort() {.importc: "abort", nodecl.}
proc c_feof(stream: C_TextFileStar): bool {.importc: "feof", nodecl.}
proc c_malloc(size: int): pointer {.importc: "malloc", nodecl.}
proc c_free(p: pointer) {.importc: "free", nodecl.}
proc c_realloc(p: pointer, newsize: int): pointer {.importc: "realloc", nodecl.}

8
lib/assign.nim
View file

@ -43,12 +43,8 @@ proc genericAssign(dest, src: Pointer, mt: PNimType) =
x^ = nil
return
assert(dest != nil)
when defined(boehmGC):
unsureAsgnRef(cast[ppointer](dest),
newObj(seq.len * mt.base.size + GenericSeqSize))
else:
unsureAsgnRef(cast[ppointer](dest),
newObj(mt, seq.len * mt.base.size + GenericSeqSize))
unsureAsgnRef(cast[ppointer](dest),
newObj(mt, seq.len * mt.base.size + GenericSeqSize))
var dst = cast[taddress](cast[ppointer](dest)^)
for i in 0..seq.len-1:
genericAssign(

131
lib/base/cgi.nim
View file

@ -103,71 +103,77 @@ proc cgiError*(msg: string) {.noreturn.} =
e.msg = msg
raise e
proc getEncodedData(allowedMethods: set[TRequestMethod]): string =
case getenv("REQUEST_METHOD")
of "POST":
if methodPost notin allowedMethods:
cgiError("'REQUEST_METHOD' 'POST' is not supported")
var L = parseInt(getenv("CONTENT_LENGTH"))
result = newString(L)
if readBuffer(stdin, addr(result[0]), L) != L:
cgiError("cannot read from stdin")
of "GET":
if methodGet notin allowedMethods:
cgiError("'REQUEST_METHOD' 'GET' is not supported")
result = getenv("QUERY_STRING")
else:
if methodNone notin allowedMethods:
cgiError("'REQUEST_METHOD' must be 'POST' or 'GET'")
iterator decodeData*(allowedMethods: set[TRequestMethod] =
{methodNone, methodPost, methodGet}): tuple[key, value: string] =
## Reads and decodes CGI data and yields the (name, value) pairs the
## data consists of. If the client does not use a method listed in the
## `allowedMethods` set, an `ECgi` exception is raised.
var enc = getEncodedData(allowedMethods)
if not isNil(enc):
# decode everything in one pass:
var i = 0
var name = ""
var value = ""
while enc[i] != '\0':
setLen(name, 0) # reuse memory
while true:
case enc[i]
of '\0': break
of '%':
var x = 0
handleHexChar(enc[i+1], x)
handleHexChar(enc[i+2], x)
inc(i, 2)
add(name, chr(x))
of '+': add(name, ' ')
of '=', '&': break
else: add(name, enc[i])
inc(i)
if enc[i] != '=': cgiError("'=' expected")
inc(i) # skip '='
setLen(value, 0) # reuse memory
while true:
case enc[i]
of '%':
var x = 0
handleHexChar(enc[i+1], x)
handleHexChar(enc[i+2], x)
inc(i, 2)
add(value, chr(x))
of '+': add(value, ' ')
of '&', '\0': break
else: add(value, enc[i])
inc(i)
yield (name, value)
if enc[i] == '&': inc(i)
elif enc[i] == '\0': break
else: cgiError("'&' expected")
proc readData*(allowedMethods: set[TRequestMethod] =
{methodNone, methodPost, methodGet}): PStringTable =
## Read CGI data. If the client does not use a method listed in the
## `allowedMethods` set, an `ECgi` exception is raised.
result = newStringTable()
var enc: string # encoded data
case getenv("REQUEST_METHOD")
of "POST":
if methodPost notin allowedMethods:
cgiError("'REQUEST_METHOD' 'POST' is not supported")
# read from stdin:
var L = parseInt(getenv("CONTENT_LENGTH"))
enc = newString(L)
if readBuffer(stdin, addr(enc[0]), L) != L:
cgiError("cannot read from stdin")
of "GET":
if methodGet notin allowedMethods:
cgiError("'REQUEST_METHOD' 'GET' is not supported")
# read from the QUERY_STRING environment variable:
enc = getenv("QUERY_STRING")
else:
if methodNone in allowedMethods:
return result
else:
cgiError("'REQUEST_METHOD' must be 'POST' or 'GET'")
# decode everything in one pass:
var i = 0
var name = ""
var value = ""
while true:
setLen(name, 0) # reuse memory
while true:
case enc[i]
of '\0': return
of '%':
var x = 0
handleHexChar(enc[i+1], x)
handleHexChar(enc[i+2], x)
inc(i, 2)
add(name, chr(x))
of '+': add(name, ' ')
of '=', '&': break
else: add(name, enc[i])
inc(i)
if enc[i] != '=': cgiError("'=' expected")
inc(i) # skip '='
setLen(value, 0) # reuse memory
while true:
case enc[i]
of '%':
var x = 0
handleHexChar(enc[i+1], x)
handleHexChar(enc[i+2], x)
inc(i, 2)
add(value, chr(x))
of '+': add(value, ' ')
of '&', '\0': break
else: add(value, enc[i])
inc(i)
for name, value in decodeData(allowedMethods):
result[name] = value
if enc[i] == '&': inc(i)
elif enc[i] == '\0': break
else: cgiError("'&' expected")
proc validateData*(data: PStringTable, validKeys: openarray[string]) =
## validates data; raises `ECgi` if this fails. This checks that each variable
## name of the CGI `data` occurs in the `validKeys` array.
@ -323,8 +329,13 @@ proc setTestData*(keysvalues: openarray[string]) =
proc writeContentType*() =
## call this before starting to send your HTML data to `stdout`. This
## is just a shorthand for:
## implements this part of the CGI protocol:
##
## .. code-block:: Nimrod
## write(stdout, "Content-type: text/html\n\n")
##
## It also modifies the debug stack traces so that they contain
## ``<br />`` and are easily readable in a browser.
write(stdout, "Content-type: text/html\n\n")
system.stackTraceNewLine = "<br />\n"

20
lib/excpt.nim
View file

@ -70,6 +70,8 @@ var
framePtr {.exportc.}: PFrame
tempFrames: array [0..127, PFrame] # cannot be allocated on the stack!
stackTraceNewLine* = "\n" ## undocumented feature
proc auxWriteStackTrace(f: PFrame, s: var string) =
const
@ -101,19 +103,21 @@ proc auxWriteStackTrace(f: PFrame, s: var string) =
if tempFrames[j] == nil:
add(s, "(")
add(s, $(total-i-1))
add(s, " calls omitted) ...\n")
add(s, " calls omitted) ...")
else:
add(s, $tempFrames[j].procname)
if tempFrames[j].line > 0:
add(s, ", line: ")
add(s, $tempFrames[j].line)
add(s, "\n")
add(s, stackTraceNewLine)
proc rawWriteStackTrace(s: var string) =
if framePtr == nil:
add(s, "No stack traceback available\n")
add(s, "No stack traceback available")
add(s, stackTraceNewLine)
else:
add(s, "Traceback (most recent call last)\n")
add(s, "Traceback (most recent call last)")
add(s, stackTraceNewLine)
auxWriteStackTrace(framePtr, s)
proc quitOrDebug() {.inline.} =
@ -151,6 +155,8 @@ var
proc internalAssert(file: cstring, line: int, cond: bool) {.compilerproc.} =
if not cond:
#c_fprintf(c_stdout, "Assertion failure: file %s line %ld\n", file, line)
#quit(1)
GC_disable() # BUGFIX: `$` allocates a new string object!
if not isNil(assertBuf):
# BUGFIX: when debugging the GC, assertBuf may be nil
@ -162,7 +168,11 @@ proc internalAssert(file: cstring, line: int, cond: bool) {.compilerproc.} =
add(assertBuf, "\n")
gAssertionFailed.msg = assertBuf
GC_enable()
raise gAssertionFailed # newException(EAssertionFailed, assertBuf)
if gAssertionFailed != nil:
raise gAssertionFailed
else:
c_fprintf(c_stdout, "Assertion failure: file %s line %ld\n", file, line)
quit(1)
proc WriteStackTrace() =
var s = ""

368
lib/gc.nim
View file

@ -9,23 +9,17 @@
# Garbage Collector
# Current Features:
# * incremental
# * non-recursive
# * generational
#
# The basic algorithm is *Deferrent Reference Counting* with cycle detection.
# Special care has been taken to avoid recursion as far as possible to avoid
# stack overflows when traversing deep datastructures. This is comparable to
# an incremental and generational GC. It should be well-suited for soft real
# time applications (like games).
#
# Future Improvements:
# * Support for multi-threading. However, locks for the reference counting
# might turn out to be too slow.
# ---------------------------------------------------------------------------
proc getOccupiedMem(): int = return tlsfUsed()
proc getFreeMem(): int = return tlsfMax() - tlsfUsed()
proc getTotalMem(): int = return tlsfMax()
# ---------------------------------------------------------------------------
const
CycleIncrease = 2 # is a multiplicative increase
InitialCycleThreshold = 4*1024*1024 # X MB because cycle checking is slow
@ -36,14 +30,14 @@ const
const
rcIncrement = 0b1000 # so that lowest 3 bits are not touched
# NOTE: Most colors are currently unused
rcBlack = 0b000 # cell is colored black; in use or free
rcGray = 0b001 # possible member of a cycle
rcWhite = 0b010 # member of a garbage cycle
rcBlack = 0b000 # cell is colored black; in use or free
rcGray = 0b001 # possible member of a cycle
rcWhite = 0b010 # member of a garbage cycle
rcPurple = 0b011 # possible root of a cycle
rcZct = 0b100 # in ZCT
rcRed = 0b101 # Candidate cycle undergoing sigma-computation
rcZct = 0b100 # in ZCT
rcRed = 0b101 # Candidate cycle undergoing sigma-computation
rcOrange = 0b110 # Candidate cycle awaiting epoch boundary
rcShift = 3 # shift by rcShift to get the reference counter
rcShift = 3 # shift by rcShift to get the reference counter
colorMask = 0b111
type
TWalkOp = enum
@ -52,21 +46,22 @@ type
TFinalizer {.compilerproc.} = proc (self: pointer)
# A ref type can have a finalizer that is called before the object's
# storage is freed.
TGcHeap {.final, pure.} = object # this contains the zero count and
# non-zero count table
mask: TAddress # mask for fast pointer detection
zct: TCellSeq # the zero count table
stackCells: TCellSet # cells and addresses that look like a cell but
# aren't of the hardware stack
TGcStat {.final, pure.} = object
stackScans: int # number of performed stack scans (for statistics)
cycleCollections: int # number of performed full collections
maxThreshold: int # max threshold that has been set
maxStackSize: int # max stack size
maxStackPages: int # max number of pages in stack
cycleTableSize: int # max entries in cycle table
maxStackCells: int # max stack cells in ``decStack``
cycleTableSize: int # max entries in cycle table
TGcHeap {.final, pure.} = object # this contains the zero count and
# non-zero count table
zct: TCellSeq # the zero count table
decStack: TCellSeq # cells in the stack that are to decref again
cycleRoots: TCellSet
tempStack: TCellSeq # temporary stack for recursion elimination
stat: TGcStat
var
stackBottom: pointer
@ -82,13 +77,13 @@ var
proc unsureAsgnRef(dest: ppointer, src: pointer) {.compilerproc.}
# unsureAsgnRef updates the reference counters only if dest is not on the
# stack. It is used by the code generator if it cannot decide wether a
# reference is in the stack or not (this can happen for out/var parameters).
# reference is in the stack or not (this can happen for var parameters).
#proc growObj(old: pointer, newsize: int): pointer {.compilerproc.}
proc newObj(typ: PNimType, size: int): pointer {.compilerproc.}
proc newSeq(typ: PNimType, len: int): pointer {.compilerproc.}
proc addZCT(s: var TCellSeq, c: PCell) {.noinline.} =
if (c.refcount and colorMask) != rcZct:
if (c.refcount and rcZct) == 0:
c.refcount = c.refcount and not colorMask or rcZct
add(s, c)
@ -131,7 +126,7 @@ proc GC_disableMarkAndSweep() =
# set to the max value to suppress the cycle detector
# this that has to equals zero, otherwise we have to round up UnitsPerPage:
when BitsPerPage mod BitsPerUnit != 0:
when BitsPerPage mod (sizeof(int)*8) != 0:
{.error: "(BitsPerPage mod BitsPerUnit) should be zero!".}
when debugGC:
@ -203,8 +198,7 @@ template gcTrace(cell, state: expr): stmt =
# -----------------------------------------------------------------------------
# forward declarations:
proc updateZCT()
proc collectCT(gch: var TGcHeap, zctUpdated: bool)
proc collectCT(gch: var TGcHeap)
proc IsOnStack(p: pointer): bool {.noinline.}
proc forAllChildren(cell: PCell, op: TWalkOp)
proc doOperation(p: pointer, op: TWalkOp)
@ -232,7 +226,7 @@ proc decRef(c: PCell) {.inline.} =
when stressGC:
if c.refcount <% rcIncrement:
writeCell("broken cell", c)
assert(c.refcount >% rcIncrement)
assert(c.refcount >=% rcIncrement)
c.refcount = c.refcount -% rcIncrement
if c.refcount <% rcIncrement:
addZCT(gch.zct, c)
@ -242,7 +236,6 @@ proc decRef(c: PCell) {.inline.} =
proc incRef(c: PCell) {.inline.} =
c.refcount = c.refcount +% rcIncrement
if canBeCycleRoot(c):
# OPT: the code generator should special case this
incl(gch.cycleRoots, c)
proc nimGCref(p: pointer) {.compilerproc, inline.} = incRef(usrToCell(p))
@ -277,19 +270,18 @@ proc unsureAsgnRef(dest: ppointer, src: pointer) =
proc initGC() =
when traceGC:
for i in low(TCellState)..high(TCellState): CellSetInit(states[i])
gch.stackScans = 0
gch.cycleCollections = 0
gch.maxThreshold = 0
gch.maxStackSize = 0
gch.maxStackPages = 0
gch.cycleTableSize = 0
for i in low(TCellState)..high(TCellState): Init(states[i])
gch.stat.stackScans = 0
gch.stat.cycleCollections = 0
gch.stat.maxThreshold = 0
gch.stat.maxStackSize = 0
gch.stat.maxStackCells = 0
gch.stat.cycleTableSize = 0
# init the rt
init(gch.zct)
init(gch.tempStack)
CellSetInit(gch.cycleRoots)
CellSetInit(gch.stackCells)
gch.mask = 0
Init(gch.cycleRoots)
Init(gch.decStack)
new(gOutOfMem) # reserve space for the EOutOfMemory exception here!
proc forAllSlotsAux(dest: pointer, n: ptr TNimNode, op: TWalkOp) =
@ -333,54 +325,63 @@ proc forAllChildren(cell: PCell, op: TWalkOp) =
of tyString: nil
else: assert(false)
proc checkCollection(zctUpdated: bool) {.inline.} =
proc checkCollection {.inline.} =
# checks if a collection should be done
if recGcLock == 0:
collectCT(gch, zctUpdated)
collectCT(gch)
proc newObj(typ: PNimType, size: int): pointer =
# generates a new object and sets its reference counter to 0
assert(typ.kind in {tyRef, tyString, tySequence})
var zctUpdated = false
if gch.zct.len >= ZctThreshold:
updateZCT()
zctUpdated = true
# check if we have to collect:
checkCollection(zctUpdated)
var res = cast[PCell](gcAlloc(size + sizeof(TCell)))
when stressGC: assert((cast[TAddress](res) and (MemAlignment-1)) == 0)
checkCollection()
var res = cast[PCell](rawAlloc(allocator, size + sizeof(TCell)))
zeroMem(res, size+sizeof(TCell))
assert((cast[TAddress](res) and (MemAlign-1)) == 0)
# now it is buffered in the ZCT
res.typ = typ
when debugGC:
if framePtr != nil and framePtr.prev != nil:
res.filename = framePtr.prev.filename
res.line = framePtr.prev.line
res.refcount = rcZct # refcount is zero, but mark it to be in the ZCT
add(gch.zct, res) # its refcount is zero, so add it to the ZCT
gch.mask = gch.mask or cast[TAddress](res)
res.refcount = rcZct # refcount is zero, but mark it to be in the ZCT
assert(isAllocatedPtr(allocator, res))
# its refcount is zero, so add it to the ZCT:
block addToZCT:
# we check the last 8 entries (cache line) for a slot
# that could be reused
var L = gch.zct.len
var d = gch.zct.d
for i in countdown(L-1, max(0, L-8)):
var c = d[i]
if c.refcount >=% rcIncrement:
c.refcount = c.refcount and not colorMask
d[i] = res
break addToZCT
add(gch.zct, res)
when logGC: writeCell("new cell", res)
gcTrace(res, csAllocated)
result = cellToUsr(res)
proc newSeq(typ: PNimType, len: int): pointer =
# XXX: overflow checks!
result = newObj(typ, len * typ.base.size + GenericSeqSize)
result = newObj(typ, addInt(mulInt(len, typ.base.size), GenericSeqSize))
cast[PGenericSeq](result).len = len
cast[PGenericSeq](result).space = len
proc growObj(old: pointer, newsize: int): pointer =
checkCollection(false)
checkCollection()
var ol = usrToCell(old)
assert(ol.typ != nil)
assert(ol.typ.kind in {tyString, tySequence})
var res = cast[PCell](gcAlloc(newsize + sizeof(TCell)))
var res = cast[PCell](rawAlloc(allocator, newsize + sizeof(TCell)))
var elemSize = 1
if ol.typ.kind != tyString:
elemSize = ol.typ.base.size
copyMem(res, ol, cast[PGenericSeq](old).len*elemSize +
GenericSeqSize + sizeof(TCell))
assert((cast[TAddress](res) and (MemAlignment-1)) == 0)
var oldsize = cast[PGenericSeq](old).len*elemSize + GenericSeqSize
copyMem(res, ol, oldsize + sizeof(TCell))
zeroMem(cast[pointer](cast[TAddress](res)+% oldsize +% sizeof(TCell)),
newsize-oldsize)
assert((cast[TAddress](res) and (MemAlign-1)) == 0)
assert(res.refcount shr rcShift <=% 1)
#if res.refcount <% rcIncrement:
# add(gch.zct, res)
@ -395,13 +396,12 @@ proc growObj(old: pointer, newsize: int): pointer =
break
dec(j)
if canBeCycleRoot(ol): excl(gch.cycleRoots, ol)
gch.mask = gch.mask or cast[TAddress](res)
when logGC:
writeCell("growObj old cell", ol)
writeCell("growObj new cell", res)
gcTrace(ol, csZctFreed)
gcTrace(res, csAllocated)
when reallyDealloc: tlsf_free(ol)
when reallyDealloc: rawDealloc(allocator, ol)
else:
assert(ol.typ != nil)
zeroMem(ol, sizeof(TCell))
@ -409,13 +409,6 @@ proc growObj(old: pointer, newsize: int): pointer =
# ---------------- cycle collector -------------------------------------------
# When collecting cycles, we have to consider the following:
# * there may still be references in the stack
# * some cells may still be in the ZCT, because they are referenced from
# the stack (!), so their refcounts are zero
# the ZCT is a subset of stackCells here, so we only need to care
# for stackcells
proc doOperation(p: pointer, op: TWalkOp) =
if p == nil: return
var c: PCell = usrToCell(p)
@ -438,36 +431,25 @@ proc collectCycles(gch: var TGcHeap) =
for c in elements(gch.cycleRoots):
inc(tabSize)
forallChildren(c, waCycleDecRef)
gch.cycleTableSize = max(gch.cycleTableSize, tabSize)
gch.stat.cycleTableSize = max(gch.stat.cycleTableSize, tabSize)
# restore reference counts (a depth-first traversal is needed):
var marker, newRoots: TCellSet
CellSetInit(marker)
CellSetInit(newRoots)
var marker: TCellSet
Init(marker)
for c in elements(gch.cycleRoots):
var needsRestore = false
if c in gch.stackCells:
needsRestore = true
incl(newRoots, c)
# we need to scan this later again; maybe stack changes
# NOTE: adding to ZCT here does NOT work
elif c.refcount >=% rcIncrement:
needsRestore = true
if needsRestore:
if c notin marker:
incl(marker, c)
if c.refcount >=% rcIncrement:
if not containsOrIncl(marker, c):
gch.tempStack.len = 0
forAllChildren(c, waPush)
while gch.tempStack.len > 0:
dec(gch.tempStack.len)
var d = gch.tempStack.d[gch.tempStack.len]
d.refcount = d.refcount +% rcIncrement
if d notin marker and d in gch.cycleRoots:
incl(marker, d)
if d in gch.cycleRoots and not containsOrIncl(marker, d):
forAllChildren(d, waPush)
# remove cycles:
for c in elements(gch.cycleRoots):
if c.refcount <% rcIncrement and c notin gch.stackCells:
if c.refcount <% rcIncrement:
gch.tempStack.len = 0
forAllChildren(c, waPush)
while gch.tempStack.len > 0:
@ -480,21 +462,23 @@ proc collectCycles(gch: var TGcHeap) =
prepareDealloc(c)
gcTrace(c, csCycFreed)
when logGC: writeCell("cycle collector dealloc cell", c)
when reallyDealloc: tlsf_free(c)
when reallyDealloc: rawDealloc(allocator, c)
else:
assert(c.typ != nil)
zeroMem(c, sizeof(TCell))
CellSetDeinit(gch.cycleRoots)
gch.cycleRoots = newRoots
Deinit(gch.cycleRoots)
Init(gch.cycleRoots)
proc gcMark(p: pointer) {.noinline.} =
proc gcMark(p: pointer) {.inline.} =
# the addresses are not as objects on the stack, so turn them to objects:
var cell = usrToCell(p)
var c = cast[TAddress](cell)
if ((c and gch.mask) == c) and c >% 1024:
if c >% PageSize:
# fast check: does it look like a cell?
when logGC: cfprintf(cstdout, "in stackcells %p\n", cell)
incl(gch.stackCells, cell) # yes: mark it
if isAllocatedPtr(allocator, cell):
# mark the cell:
cell.refcount = cell.refcount +% rcIncrement
add(gch.decStack, cell)
# ----------------- stack management --------------------------------------
# inspired from Smart Eiffel
@ -560,53 +544,6 @@ elif defined(hppa) or defined(hp9000) or defined(hp9000s300) or
gcMark(sp^)
sp = cast[ppointer](cast[TAddress](sp) -% sizeof(pointer))
elif defined(I386) and asmVersion:
# addresses decrease as the stack grows:
proc isOnStack(p: pointer): bool =
var
stackTop: array [0..1, pointer]
result = p >= addr(stackTop[0]) and p <= stackBottom
proc markStackAndRegisters(gch: var TGcHeap) {.noinline, cdecl.} =
# This code should be safe even for aggressive optimizers. The try
# statement safes all registers into the safepoint, which we
# scan additionally to the stack.
type
TPtrArray = array[0..0xffffff, pointer]
try:
var pa = cast[ptr TPtrArray](excHandler)
for i in 0 .. sizeof(TSafePoint) - 1:
gcMark(pa[i])
finally:
# iterate over the stack:
var max = cast[TAddress](stackBottom)
var stackTop{.volatile.}: array [0..15, pointer]
var sp {.volatile.} = cast[TAddress](addr(stackTop[0]))
while sp <= max:
gcMark(cast[ppointer](sp)^)
sp = sp +% sizeof(pointer)
when false:
var counter = 0
#mov ebx, OFFSET `stackBottom`
#mov ebx, [ebx]
asm """
pusha
mov edi, esp
call `getStackBottom`
mov ebx, eax
L1:
cmp edi, ebx
ja L2
mov eax, [edi]
call `gcMark`
add edi, 4
inc [`counter`]
jmp L1
L2:
popa
"""
cfprintf(cstdout, "stack %ld\n", counter)
else:
# ---------------------------------------------------------------------------
# Generic code for architectures where addresses decrease as the stack grows.
@ -617,82 +554,47 @@ else:
result = p >= addr(stackTop[0]) and p <= stackBottom
var
gRegisters: C_JmpBuf
jmpbufSize {.importc: "sizeof(jmp_buf)", nodecl.}: int
# a little hack to get the size of a TJmpBuf in the generated C code
# in a platform independant way
proc markStackAndRegisters(gch: var TGcHeap) {.noinline, cdecl.} =
when false:
# new version: several C compilers are too smart here
var
max = cast[TAddress](stackBottom)
stackTop: array [0..15, pointer]
if c_setjmp(gregisters) == 0'i32: # To fill the C stack with registers.
# iterate over the registers:
var sp = cast[TAddress](addr(gregisters))
while sp < cast[TAddress](addr(gregisters))+%jmpbufSize:
gcMark(cast[ppointer](sp)^)
sp = sp +% sizeof(pointer)
# iterate over the stack:
sp = cast[TAddress](addr(stackTop[0]))
while sp <= max:
gcMark(cast[ppointer](sp)^)
sp = sp +% sizeof(pointer)
else:
c_longjmp(gregisters, 42)
# this can never happen, but should trick any compiler that is
# not as smart as a human
else:
var
max = stackBottom
registers: C_JmpBuf # The jmp_buf buffer is in the C stack.
sp: PPointer # Used to traverse the stack and registers assuming
# that 'setjmp' will save registers in the C stack.
if c_setjmp(registers) == 0'i32: # To fill the C stack with registers.
sp = cast[ppointer](addr(registers))
while sp <= max:
gcMark(sp^)
sp = cast[ppointer](cast[TAddress](sp) +% sizeof(pointer))
var
max = stackBottom
registers: C_JmpBuf # The jmp_buf buffer is in the C stack.
sp: PPointer # Used to traverse the stack and registers assuming
# that 'setjmp' will save registers in the C stack.
if c_setjmp(registers) == 0'i32: # To fill the C stack with registers.
sp = cast[ppointer](addr(registers))
while sp <= max:
gcMark(sp^)
sp = cast[ppointer](cast[TAddress](sp) +% sizeof(pointer))
# ----------------------------------------------------------------------------
# end of non-portable code
# ----------------------------------------------------------------------------
proc updateZCT() =
# We have to make an additional pass over the ZCT unfortunately, because
# the ZCT may be out of date, which means it contains cells with a
# refcount > 0. The reason is that ``incRef`` does not bother to remove
# the cell from the ZCT as this might be too slow.
var j = 0
var L = gch.zct.len # because globals make it hard for the optimizer
var d = gch.zct.d
while j < L:
var c = d[j]
if c.refcount >=% rcIncrement:
when logGC: writeCell("remove from ZCT", c)
# remove from ZCT:
dec(L)
d[j] = d[L]
c.refcount = c.refcount and not colorMask
# we have a new cell at position j, so don't increment j
else:
inc(j)
gch.zct.len = L
proc CollectZCT(gch: var TGcHeap) =
var i = 0
while i < gch.zct.len:
var c = gch.zct.d[i]
assert(c.refcount <% rcIncrement)
# Note: Freeing may add child objects to the ZCT! So essentially we do
# deep freeing, which is bad for incremental operation. In order to
# avoid a deep stack, we move objects to keep the ZCT small.
# This is performance critical!
var L = addr(gch.zct.len)
while L^ > 0:
var c = gch.zct.d[0]
# remove from ZCT:
assert((c.refcount and colorMask) == rcZct)
if canBeCycleRoot(c): excl(gch.cycleRoots, c)
if c notin gch.stackCells:
# remove from ZCT:
c.refcount = c.refcount and not colorMask
gch.zct.d[i] = gch.zct.d[gch.zct.len-1]
# we have a new cell at position i, so don't increment i
dec(gch.zct.len)
c.refcount = c.refcount and not colorMask
gch.zct.d[0] = gch.zct.d[L^ - 1]
dec(L^)
if c.refcount <% rcIncrement:
# It may have a RC > 0, if it is in the hardware stack or
# it has not been removed yet from the ZCT. This is because
# ``incref`` does not bother to remove the cell from the ZCT
# as this might be too slow.
# In any case, it should be removed from the ZCT. But not
# freed. **KEEP THIS IN MIND WHEN MAKING THIS INCREMENTAL!**
if canBeCycleRoot(c): excl(gch.cycleRoots, c)
when logGC: writeCell("zct dealloc cell", c)
gcTrace(c, csZctFreed)
# We are about to free the object, call the finalizer BEFORE its
@ -700,51 +602,53 @@ proc CollectZCT(gch: var TGcHeap) =
# access invalid memory. This is done by prepareDealloc():
prepareDealloc(c)
forAllChildren(c, waZctDecRef)
when reallyDealloc: tlsf_free(c)
when reallyDealloc: rawDealloc(allocator, c)
else:
assert(c.typ != nil)
zeroMem(c, sizeof(TCell))
else:
inc(i)
when stressGC:
for j in 0..gch.zct.len-1: assert(gch.zct.d[j] in gch.stackCells)
proc collectCT(gch: var TGcHeap, zctUpdated: bool) =
proc unmarkStackAndRegisters(gch: var TGcHeap) =
var d = gch.decStack.d
for i in 0..gch.decStack.len-1:
assert isAllocatedPtr(allocator, d[i])
decRef(d[i]) # OPT: cannot create a cycle!
gch.decStack.len = 0
proc collectCT(gch: var TGcHeap) =
if gch.zct.len >= ZctThreshold or (cycleGC and
getOccupiedMem() >= cycleThreshold) or stressGC:
if not zctUpdated: updateZCT()
gch.maxStackSize = max(gch.maxStackSize, stackSize())
CellSetInit(gch.stackCells)
getOccupiedMem() >= cycleThreshold) or stressGC:
gch.stat.maxStackSize = max(gch.stat.maxStackSize, stackSize())
assert(gch.decStack.len == 0)
markStackAndRegisters(gch)
gch.maxStackPages = max(gch.maxStackPages, gch.stackCells.counter)
inc(gch.stackScans)
gch.stat.maxStackCells = max(gch.stat.maxStackCells, gch.decStack.len)
inc(gch.stat.stackScans)
collectZCT(gch)
when cycleGC:
if getOccupiedMem() >= cycleThreshold or stressGC:
collectCycles(gch)
collectZCT(gch)
inc(gch.cycleCollections)
inc(gch.stat.cycleCollections)
cycleThreshold = max(InitialCycleThreshold, getOccupiedMem() *
cycleIncrease)
gch.maxThreshold = max(gch.maxThreshold, cycleThreshold)
CellSetDeinit(gch.stackCells)
gch.stat.maxThreshold = max(gch.stat.maxThreshold, cycleThreshold)
unmarkStackAndRegisters(gch)
proc GC_fullCollect() =
var oldThreshold = cycleThreshold
cycleThreshold = 0 # forces cycle collection
collectCT(gch, false)
collectCT(gch)
cycleThreshold = oldThreshold
proc GC_getStatistics(): string =
GC_disable()
result = "[GC] total memory: " & $(getTotalMem()) & "\n" &
"[GC] occupied memory: " & $(getOccupiedMem()) & "\n" &
"[GC] stack scans: " & $gch.stackScans & "\n" &
"[GC] stack pages: " & $gch.maxStackPages & "\n" &
"[GC] cycle collections: " & $gch.cycleCollections & "\n" &
"[GC] max threshold: " & $gch.maxThreshold & "\n" &
"[GC] stack scans: " & $gch.stat.stackScans & "\n" &
"[GC] stack cells: " & $gch.stat.maxStackCells & "\n" &
"[GC] cycle collections: " & $gch.stat.cycleCollections & "\n" &
"[GC] max threshold: " & $gch.stat.maxThreshold & "\n" &
"[GC] zct capacity: " & $gch.zct.cap & "\n" &
"[GC] max cycle table size: " & $gch.cycleTableSize & "\n" &
"[GC] max stack size: " & $gch.maxStackSize
"[GC] max cycle table size: " & $gch.stat.cycleTableSize & "\n" &
"[GC] max stack size: " & $gch.stat.maxStackSize
when traceGC: writeLeakage()
GC_enable()

2
lib/lexbase.nim
View file

@ -1,7 +1,7 @@
#
#
# The Nimrod Compiler
# (c) Copyright 2008 Andreas Rumpf
# (c) Copyright 2009 Andreas Rumpf
#
# See the file "copying.txt", included in this
# distribution, for details about the copyright.

18
lib/macros.nim
View file

@ -1,15 +1,17 @@
#
#
# Nimrod's Runtime Library
# (c) Copyright 2008 Andreas Rumpf
# (c) Copyright 2009 Andreas Rumpf
#
# See the file "copying.txt", included in this
# distribution, for details about the copyright.
#
## This module contains the interface to the compiler's abstract syntax tree.
## Abstract syntax trees should be modified in macros.
## This module contains the interface to the compiler's abstract syntax
## tree (`AST`:idx:). Macros operate on this tree.
## .. include:: ../doc/astspec.txt
#[[[cog
#def toEnum(name, elems):
@ -235,3 +237,13 @@ proc newCall*(theProc: string,
result.add(newIdentNode(theProc))
result.add(args)
proc nestList*(theProc: TNimrodIdent,
x: PNimrodNode): PNimrodNode {.compileTime.} =
## nests the list `x` into a tree of call expressions:
## ``[a, b, c]`` is transformed into ``theProc(a, theProc(c, d))``
var L = x.len
result = newCall(theProc, x[L-2], x[L-1])
var a = result
for i in countdown(L-3, 0):
a = newCall(theProc, x[i], copyNimTree(a))

35
lib/math.nim
View file

@ -208,5 +208,40 @@ else:
var y = exp(2.0*x)
return (y-1.0)/(y+1.0)
type
TRunningStat* = object ## an accumulator for statistical data
n*: int ## number of pushed data
sum*, min*, max*, mean*: float ## self-explaining
oldM, oldS, newS: float
proc push*(s: var TRunningStat, x: float) =
## pushes a value `x` for processing
inc(s.n)
# See Knuth TAOCP vol 2, 3rd edition, page 232
if s.n == 1:
s.oldM = x
s.mean = x
s.oldS = 0.0
else:
s.mean = s.oldM + (x - s.oldM)/toFloat(s.n)
s.newS = s.oldS + (x - s.oldM)*(x - s.mean)
# set up for next iteration:
s.oldM = s.mean
s.oldS = s.newS
s.sum = s.sum + x
if s.min > x: s.min = x
if s.max < x: s.max = x
proc variance*(s: TRunningStat): float =
## computes the current variance of `s`
if s.n > 1: result = s.newS / (toFloat(s.n - 1))
proc standardDeviation*(s: TRunningStat): float =
## computes the current standard deviation of `s`
result = sqrt(variance(s))
{.pop.}
{.pop.}

698
lib/memman.nim
View file

@ -1,698 +0,0 @@
#
#
# Nimrod's Runtime Library
# (c) Copyright 2008 Andreas Rumpf
#
# See the file "copying.txt", included in this
# distribution, for details about the copyright.
#
# Memory manager. Based on:
# Two Levels Segregate Fit memory allocator (TLSF)
# Version 2.4.2
#
# Written by Miguel Masmano Tello <mimastel@doctor.upv.es>
#
# Thanks to Ismael Ripoll for his suggestions and reviews
#
# Copyright (C) 2008, 2007, 2006, 2005, 2004
#
# This code is released using a dual license strategy: GPL/LGPL
# You can choose the licence that better fits your requirements.
#
# Released under the terms of the GNU General Public License Version 2.0
# Released under the terms of the GNU Lesser General Public License Version 2.1
# Some IMPORTANT TLSF parameters
const
blockAlign = sizeof(pointer) * 2
maxFli = 30
maxLog2Sli = 5
maxSli = 1 shl maxLog2Sli
fliOffset = 6 # tlsf structure just will manage blocks bigger than 128 bytes
smallBlock = 128
realFli = MaxFli - fliOffset
type
TFreePtr {.final.} = object
prev, next: PBhdr
Pbhdr = ptr Tbhdr
Tbhdr {.final.} = object
prevHdr: Pbhdr # this is just valid if the first bit of size is set
size: int # the size is stored in bytes
# bit 0 indicates whether the block is used and
# bit 1 allows to know whether the previous block is free
freePtr: TFreePtr # at this offset bhdr.buffer starts (was a union in the
# C version)
TAreaInfo {.final.} = object # This structure is embedded at the beginning
# of each area, giving us enough information
# to cope with a set of areas
theEnd: Pbhdr
next: PAreaInfo
PAreaInfo = ptr TAreaInfo
TLSF {.final.} = object
tlsf_signature: int32 # the TLSF's structure signature
usedSize, maxSize: int
areaHead: PAreaInfo # A linked list holding all the existing areas
flBitmap: int32 # the first-level bitmap
# This array should have a size of REAL_FLI bits
slBitmap: array[0..realFli, int32] # the second-level bitmap
matrix: array [0..realFli, array[0..maxSli, PBhdr]]
const
minBlockSize = sizeof(TFreePtr)
bhdrOverhead = sizeof(Tbhdr) - minBlockSize
tlsfSignature = 0x2A59FA59
ptrMask = sizeof(pointer) - 1
blockSize = 0xFFFFFFFF - ptrMask
memAlign = blockAlign - 1
blockState = 0x1
prevState = 0x2
freeBlock = 0x1 # bit 0 of the block size
usedBlock = 0x0
prevFree = 0x2 # bit 1 of the block size
prevUsed = 0x0
defaultAreaSize = 64*1024 # 1024*10
pageSize = if defined(cpu32): 4096 else: 4096*2
proc getNextBlock(adr: pointer, r: int): PBhdr {.inline.} =
return cast[PBhdr](cast[TAddress](adr) +% r)
proc roundupSize(r: int): int = return (r +% memAlign) and not memAlign
proc rounddownSize(r: int): int = return r and not memAlign
proc roundup(x, v: int): int = return (((not x)+%1) and (v-%1)) +% x
proc addSize(s: PTLSF, b: Pbhdr) =
inc(s.usedSize, (b.size and blockSize) + bhdrOverhead)
s.maxSize = max(s.maxSize, s.usedSize)
proc removeSize(s: PTLSF, b: Pbhdr) =
dec(s.usedSize, (b.size and blockSize) + bhdrOverhead)
# ------------ platform specific code -----------------------------------------
when defined(posix):
const # XXX: make these variables for portability?
PROT_READ = 1 # page can be read
PROT_WRITE = 2 # page can be written
PROT_EXEC = 4 # page can be executed
PROT_NONE = 0 # page can not be accessed
MAP_SHARED = 1 # Share changes
MAP_PRIVATE = 2 # Changes are private
MAP_TYPE = 0xf # Mask for type of mapping
MAP_FIXED = 0x10 # Interpret addr exactly
MAP_ANONYMOUS = 0x20 # don't use a file
MAP_GROWSDOWN = 0x100 # stack-like segment
MAP_DENYWRITE = 0x800 # ETXTBSY
MAP_EXECUTABLE = 0x1000 # mark it as an executable
MAP_LOCKED = 0x2000 # pages are locked
MAP_NORESERVE = 0x4000 # don't check for reservations
proc mmap(adr: pointer, len: int, prot, flags, fildes: cint,
off: int): pointer {.header: "<sys/mman.h>".}
proc getNewArea(size: var int): pointer {.inline.} =
size = roundup(size, PageSize)
result = mmap(0, size, PROT_READ or PROT_WRITE,
MAP_PRIVATE or MAP_ANONYMOUS, -1, 0)
if result == nil or result == cast[pointer](-1):
raiseOutOfMem()
elif defined(windows):
const
MEM_RESERVE = 0x2000
MEM_COMMIT = 0x1000
MEM_TOP_DOWN = 0x100000
PAGE_READWRITE = 0x04
proc VirtualAlloc(lpAddress: pointer, dwSize: int, flAllocationType,
flProtect: int32): pointer {.
header: "<windows.h>", stdcall.}
proc getNewArea(size: var int): pointer {.inline.} =
size = roundup(size, PageSize)
result = VirtualAlloc(nil, size, MEM_RESERVE or MEM_COMMIT or MEM_TOP_DOWN,
PAGE_READWRITE)
if result == nil: raiseOutOfMem()
else:
{.warning: "Generic code for allocating pages is used".}
# generic implementation relying on malloc:
proc malloc(size: int): pointer {.nodecl, importc.}
proc getNewArea(size: var int): pointer {.inline.} =
size = roundup(size, PageSize)
result = malloc(size)
if result == nil: raiseOutOfMem()
# ---------------------------------------------------------------------------
# small fixed size allocator:
# Design: We manage pages. A page is of constant size, but not necessarily
# the OS's page size. Pages are managed in a hash table taking advantage of
# the fact that the OS is likely to give us pages with contingous numbers.
# A page contains either small fixed size objects of the same size or
# variable length objects. An object's size is always aligned at 16 byte
# boundary. Huge objects are dealt with the TLSF algorithm.
# The design supports iterating over any object in a fast way.
# A bitset contains any page that starts an allocated page. The page may be
# empty however. This bitset can be used to quickly determine if a given
# page belongs to the GC heap. The design of the memory allocator makes it
# simple to return unused pages back to the OS.
# Small bocks
# -----------
#
# If we use a list in the free object's space. Allocation and deallocation are
# O(1). Since any object is of the same size, iteration is quite efficient too.
# However, pointer detection is easy too: Just check if the type-field is nil.
# Deallocation sets it to nil.
# Algorithm:
# i = 0
# f = b.f # first free address
# while i < max:
# if a[i] == f: # not a valid block
# f = f.next # next free address
# else:
# a[i] is a valid object of size s
# inc(i)
# The zero count table is an array. Since we know that the RC is zero, we can
# use the bits for an index into this array. Thus multiple ZCT tables are not
# difficult to support and insertion and removal is O(1). We use negative
# indexes for this. This makes it even fast enough (and necessary!) to do a ZCT
# removal if the RC is incremented.
#
# Huge blocks
# -----------
#
# Huge blocks are always rounded up to a multiple of the page size. These are
# called *strides*. We also need to keep an index structure
# of (stridesize, pagelist).
#
const
MemAlign = 8
PageShift = if sizeof(int) == 4: 12 else: 13
PageSize = 1 shl PageShift
type
TFreeList {.final.} = object
next, prev: ptr TFreeList
TPageDesc {.final.} = object # the start of a stride always starts with this!
size: int # lowest bit is set, if it is a huge block
free: ptr TFreeList # only used if it manages multiple cells
snext, sprev: ptr TPageDesc # next and prev pagedescs with the same size
TCellArray {.final.} = object
i: int # length
d: ptr array [0..1000_000, TCell]
TPageManager = table[page, ptr TPageDesc]
TGcHeap {.final.} = object
# structure that manages the garbage collected heap
zct: TCellArray
stackCells: TCellArray
smallBlocks: array [PageSize div MemAlign, ptr TPageDesc]
freeLists: array [PageSize div MemAlign, ptr TFreeList]
pages: TPageManager
usedPages: TPageList
freePages: TPageList
# small blocks:
proc allocSmall(var h: TGcHeap, size: int): pointer =
var s = align(size)
var f = h.freeLists[s]
if f != nil:
f.prev = f.next # remove from list
f.next.prev = f.prev
return f
var p = h.smallBlocks[s]
if p == nil or p.free == nil:
p = newSmallBlock(s, p)
h.smallBlocks[s] = p
proc decRef(cell: PCell) {.inline.} =
assert(cell in ct.AT)
assert(cell.refcount > 0) # this should be the case!
assert(seqCheck(cell))
dec(cell.refcount)
if cell.refcount == 0:
# add to zero count table:
zct.d[zct.i] = cell
cell.recfcount = -zct.i
inc(zct.i)
proc incRef(cell: PCell) {.inline.} =
assert(seqCheck(cell))
if cell.refcount < 0:
# remove from zero count table:
zct.d[-cell.refcount] = zct.d[zct.i-1]
dec(zct.i)
cell.refcount = 1
else:
inc(cell.refcount)
proc asgnRef(dest: ppointer, src: pointer) =
# the code generator calls this proc!
assert(not isOnStack(dest))
# BUGFIX: first incRef then decRef!
if src != nil: incRef(usrToCell(src))
if dest^ != nil: decRef(usrToCell(dest^))
dest^ = src
# ----------------------------------------------------------------------------
# helpers
const
table: array[0..255, int8] = [
-1, 0, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4,
4, 4, 4, 4, 4, 4, 4, 4, 4,
5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5,
5, 5, 5, 5, 5, 5, 5, 5,
6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6,
6, 6, 6, 6, 6, 6, 6, 6,
6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6,
6, 6, 6, 6, 6, 6, 6, 6,
7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
7, 7, 7, 7, 7, 7, 7, 7,
7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
7, 7, 7, 7, 7, 7, 7, 7,
7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
7, 7, 7, 7, 7, 7, 7, 7,
7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
7, 7, 7, 7, 7, 7, 7, 7
]
proc ls_bit(i: int32): int {.inline.} =
var
a: int = 0
x: int = i and -i
if x <=% 0xffff:
if x <=% ff: a = 0
else: a = 8
elif x <=% 0xffffff: a = 16
else: a = 24
return table[x shr a] + a
proc ms_bit(i: int): int {.inline.} =
var
a = if i <=% 0xffff: (if i <=% 0xff: 0 else: 8) elif
i <=% 0xffffff: 16 else: 24
return table[i shr a] + a
proc set_bit[IX](nr: int, adr: var array[IX, int32]) {.inline.} =
adr[nr shr 5] = adr[nr shr 5] or (1 shl (nr and 0x1f))
proc clear_bit[IX](nr: int, adr: var array[IX, int32]) {.inline.} =
adr[nr shr 5] = adr[nr shr 5] and not (1 shl (nr and 0x1f))
proc mappingSearch(r, fl, sl: var int) {.inline.} =
if r < smallBlock:
fl = 0
sl = r div (smallBlock div maxSli)
else:
var t = (1 shl (ms_bit(r) - maxLog2Sli)) - 1
r = r + t
fl = ms_bit(r)
sl = (r shl (fl - maxLog2Sli)) - maxSli
fl = fl - fliOffset
r = r and not t
proc mappingInsert(r: int, fl, sl: var int) {.inline.} =
if r < smallBlock:
fl = 0
sl = r div (smallBlock div maxSli)
else:
fl = ms_bit(r)
sl = (r shr (fl - maxLog2Sli)) - maxSli
fl = fl - fliOffset
proc findSuitableBlock(t: var TLSF, fl, sl: var int): Pbhdr =
var tmp = t.slBitmap[fl] and ((not 0) shl sl)
if tmp != 0:
sl = ls_bit(tmp)
result = t.matrix[fl][sl]
else:
fl = ls_bit(t.flBitmap and (not 0 shl (fl + 1)))
if fl > 0: # likely
sl = ls_bit(t.slBitmap[fl])
result = t.matrix[fl][sl]
proc extractBlockHdr(b: Pbhdr, t: var TLSF, fl, sl: int) {.inline.} =
t.matrix[fl][sl] = b.freePtr.next
if t.matrix[fl][sl] != nil:
t.matrix[fl][sl].freePtr.prev = nil
else:
clear_bit(sl, t.slBitmap[fl])
if t.slBitmap[fl] == 0:
clear_bit(fl, t.flBitmap)
b.freePtr.prev = nil
b.freePtr.next = nil
proc extractBlock(b: Pbhdr, t: var TLSF, fl, sl: int) {.inline.} =
if b.freePtr.next != nil:
b.freePtr.next.freePtr.prev = b.freePtr.prev
if b.freePtr.prev != nil:
b.freePtr.prev.freePtr.next = b.freePtr.next
if t.matrix[fl][sl] == b:
t.matrix[fl][sl] = b.freePtr.next
if t.matrix[fl][sl] == nil:
clear_bit(sl, t.slBitmap[fl])
if t.slBitmap[fl] == 0:
clear_bit(fl, t.flBitmap)
b.freePtr.prev = nil
b.freePtr.next = nil
proc insertBlock(b: Pbhdr, t: var TLSF, fl, sl: int) {.inline.} =
b.freePtr.prev = nil
b.freePtr.next = t.matrix[fl][sl]
if t.matrix[fl][sl] != nil:
t.matrix[fl][sl].freePtr.prev = b
t.matrix[fl][sl] = b
set_bit(sl, t.slBitmap[fl])
set_bit(fl, t.flBitmap)
proc getBuffer(b: Pbhdr): pointer {.inline.} =
result = cast[pointer](addr(b.freePtr))
proc processArea(area: pointer, size: int): Pbhdr =
var
b, lb, ib: Pbhdr
ai: PAreaInfo
ib = cast[Pbhdr](area)
if sizeof(TAreaInfo) < minBlockSize:
ib.size = minBlockSize or usedBlock or prevUsed
else
ib.size = roundupSize(sizeof(TAreaInfo)) or usedBlock or prevUsed
b = getNextBlock(getBuffer(ib), ib.size and blockSize)
b.size = rounddownSize(size - 3 * bhdrOverhead - (ib.size and blockSize)) or
usedBlock or prevUsed
b.freePtr.prev = nil
b.freePtr.next = nil
lb = getNextBlock(getBuffer(b), b.size and blockSize)
lb.prevHdr = b
lb.size = 0 or usedBlock or prevFree
ai = cast[PAreaInfo](getBuffer(ib))
ai.next = nil
ai.theEnd = lb
return ib
# ----------------------------------------------------------------------------
# Begin of the allocator code
proc initMemoryPool(memPoolSize: int, memPool: pointer): int =
var
t: PLSF
b, ib: Pbhdr
if memPool == nil or memPoolSize < sizeof(TLSF) + bhdrOverhead * 8:
writeToStdErr("initMemoryPool(): memory_pool invalid\n")
return -1
if (cast[TAddress](memPool) and ptrMask) != 0:
writeToStdErr("initMemoryPool(): memPool must be aligned to a word\n")
return -1
t = cast[PLSF](memPool)
# Check if already initialised
if t.signature == tlsfSignature:
b = getNextBlock(memPool, roundupSize(sizeof(TLSF)))
return b.size and blockSize
zeroMem(memPool, sizeof(TLSF))
t.signature = tlsfSignature
ib = processArea(getNextBlock(memPool, roundupSize(sizeof(TLSF))),
rounddownSize(memPoolSize - sizeof(TLSF)))
b = getNextBlock(getBuffer(ib), ib.size and blockSize)
freeEx(getBuffer(b), t)
t.areaHead = cast[PAreaInfo](getBuffer(ib))
t.used_size = memPoolSize - (b.size and blockSize)
t.max_size = t.used_size
return b.size and blockSize
proc addNewArea(area: pointer, areaSize: int, t: var TLSF): int =
var
p, ptrPrev, ai: PAreaInfo
ib0, b0, lb0, ib1, b1, lb1, nextB: Pbhdr
zeroMem(area, areaSize)
p = t.areaHead
ptrPrev = 0
ib0 = processArea(area, areaSize)
b0 = getNextBlock(getBuffer(ib0), ib0.size and blockSize)
lb0 = getNextBlock(getBuffer(b0), b0.size and blockSize)
# Before inserting the new area, we have to merge this area with the
# already existing ones
while p != nil:
ib1 = cast[Pbhdr](cast[TAddress](p) -% bhdrOverhead)
b1 = getNextBlock(getBuffer(ib1), ib1.size and blockSize)
lb1 = p.theEnd
# Merging the new area with the next physically contigous one
if cast[TAddress](ib1) == cast[TAddress](lb0) +% bhdrOverhead:
if t.areaHead == p:
t.areaHead = p.next
p = p.next
else:
ptrPrev.next = p.next
p = p.next
b0.size = rounddownSize((b0.size and blockSize) +
(ib1.size and blockSize) + 2 * bhdrOverhead) or
usedBlock or prevUsed
b1.prevHdr = b0
lb0 = lb1
continue
# Merging the new area with the previous physically contigous one
if getBuffer(lb1) == pointer(ib0):
if t.areaHead == p:
t.areaHead = p.next
p = p.next
else:
ptrPrev.next = p.next
p = p.next
lb1->size = rounddownSize((b0.size and blockSize) +
(ib0.size and blockSize) + 2 * bhdrOverhead) or
usedBlock or (lb1.size and prevState)
nextB = getNextBlock(getBuffer(lb1), lb1.size and blockSize)
nextB.prevHdr = lb1
b0 = lb1
ib0 = ib1
continue
ptrPrev = p
p = p.next
# Inserting the area in the list of linked areas
ai = cast[PAreaInfo](getBuffer(ib0))
ai.next = t.areaHead
ai.theEnd = lb0
t.areaHead = ai
freeEx(getBuffer(b0), memPool)
return (b0.size and blockSize)
proc mallocEx(asize: int, t: var TLSF): pointer =
var
b, b2, nextB: Pbhdr
fl, sl, tmpSize, size: int
size = if asize < minBlockSize: minBlockSize else: roundupSize(asize)
# Rounding up the requested size and calculating fl and sl
mappingSearch(size, fl, sl)
# Searching a free block, recall that this function changes the values
# of fl and sl, so they are not longer valid when the function fails
b = findSuitableBlock(tlsf, fl, sl)
if b == nil:
# Growing the pool size when needed
# size plus enough room for the required headers:
var areaSize = max(size + bhdrOverhead * 8, defaultAreaSize)
var area = getNewArea(areaSize)
addNewArea(area, areaSize, t)
# Rounding up the requested size and calculating fl and sl
mappingSearch(size, fl, sl)
# Searching a free block
b = findSuitableBlock(t, fl, sl)
if b == nil:
raiseOutOfMem()
extractBlockHdr(b, t, fl, sl)
#-- found:
nextB = getNextBlock(getBuffer(b), b.size and blockSize)
# Should the block be split?
tmpSize = (b.size and blockSize) - size
if tmpSize >= sizeof(Tbhdr):
dec(tmpSize, bhdrOverhead)
b2 = getNextBlock(getBuffer(b), size)
b2.size = tmpSize or freeBlock or prevUsed
nextB.prevHdr = b2
mappingInsert(tmpSize, fl, sl)
insertBlock(b2, t, fl, sl)
b.size = size or (b.size and prevState)
else:
nextB.size = nextB.size and not prevFree
b.size = b.size and not freeBlock # Now it's used
addSize(t, b)
return getBuffer(b)
proc freeEx(p: pointer, t: var TLSF) =
var
fl = 0
sl = 0
b, tmpB: Pbhdr
assert(p != nil)
b = cast[Pbhdr](cast[TAddress](p) -% bhdrOverhead)
b.size = b.size or freeBlock
removeSize(t, b)
b.freePtr.prev = nil
b.freePtr.next = nil
tmpB = getNextBlock(getBuffer(b), b.size and blockSize)
if (tmpB.size and freeBlock) != 0:
mappingInsert(tmpB.size and blockSize, fl, sl)
extractBlock(tmpB, t, fl, sl)
inc(b.size, (tmpB.size and blockSize) + bhdrOverhead)
if (b.size and prevFree) != 0:
tmpB = b.prevHdr
mappingInsert(tmpB.size and blockSize, fl, sl)
extractBlock(tmpB, t, fl, sl)
inc(tmpB.size, (b.size and blockSize) + bhdrOverhead)
b = tmpB
mappingInsert(b.size and blockSize, fl, sl)
insertBlock(b, t, fl, sl)
tmpB = getNextBlock(getBuffer(b), b.size and blockSize)
tmpB.size = tmpB.size or prevFree
tmpB.prevHdr = b
proc reallocEx(p: pointer, newSize: int, t: var TLSF): pointer =
var
cpsize, fl, sl, tmpSize: int
b, tmpB, nextB: Pbhdr
assert(p != nil)
assert(newSize > 0)
b = cast[Pbhdr](cast[TAddress](p) -% bhdrOverhead)
nextB = getNextBlock(getBuffer(b), b.size and blockSize)
newSize = if newSize < minBlockSize: minBlockSize else: roundupSize(newSize)
tmpSize = b.size and blockSize
if newSize <= tmpSize:
removeSize(t, b)
if (nextB.size and freeBlock) != 0:
mappingInsert(nextB.size and blockSize, fl, sl)
extractBlock(nextB, t, fl, sl)
inc(tmpSize, (nextB.size and blockSize) + bhdrOverhead)
nextB = getNextBlock(getBuffer(nextB), nextB.size and blockSize)
# We always reenter this free block because tmpSize will
# be greater then sizeof(Tbhdr)
dec(tmpSize, newSize)
if tmpSize >= sizeof(Tbhdr):
dec(tmpSize, bhdrOverhead)
tmpB = getNextBlock(getBuffer(b), newSize)
tmpB.size = tmpSize or freeBlock or prevUsed
nextB.prevHdr = tmpB
nextB.size = nextB.size or prevFree
mappingInsert(tmpSize, fl, sl)
insertBlock(tmpB, t, fl, sl)
b.size = newSize or (b.size and prevState)
addSize(t, b)
return getBuffer(b)
if (nextB.size and freeBlock) != 0:
if newSize <= tmpSize + (nextB.size and blockSize):
removeSize(t, b)
mappingInsert(nextB.size and blockSize, fl, sl)
extractBlock(nextB, t, fl, sl)
inc(b.size, (nextB.size and blockSize) + bhdrOverhead)
nextB = getNextBlock(getBuffer(b), b.size and blockSize)
nextB.prevHdr = b
nextB.size = nextB.size and not prevFree
tmpSize = (b.size and blockSize) - newSize
if tmpSize >= sizeof(Tbhdr):
dec(tmpSize, bhdrOverhead)
tmpB = getNextBlock(getBuffer(b), newSize)
tmpB.size = tmpSize or freeBlock or prevUsed
nextB.prevHdr = tmpB
nextB.size = nextB.size or prevFree
mappingInsert(tmpSize, fl, sl)
insertBlock(tmpB, t, fl, sl)
b.size = newSize or (b.size and prevState)
addSize(t, b)
return getBuffer(b)
var ptrAux = mallocEx(newSize, t)
cpsize = if (b.size and blockSize) > newSize: newSize else:
(b.size and blockSize)
copyMem(ptrAux, p, cpsize)
freeEx(p, memPool)
return ptrAux
proc ansiCrealloc(p: pointer, newSize: int, t: var TLSF): pointer =
if p == nil:
if newSize > 0:
result = mallocEx(newSize, t)
else:
result = nil
elif newSize <= 0:
freeEx(p, t)
result = nil
else:
result = reallocEx(p, newSize, t)
proc InitTLSF(t: var TLSF) =
var areaSize = sizeof(TLSF) + BHDR_OVERHEAD * 8 # Just a safety constant
areaSize = max(areaSize, DEFAULT_areaSize)
var area = getNewArea(areaSize)
initMemoryPool(areaSize, area)
var
t: PLSF
b, ib: Pbhdr
t = cast[PLSF](memPool)
zeroMem(area, areaSize)
t.signature = tlsfSignature
var ib = processArea(getNextBlock(memPool, roundupSize(sizeof(TLSF))),
rounddownSize(memPoolSize - sizeof(TLSF)))
var b = getNextBlock(getBuffer(ib), ib.size and blockSize)
freeEx(getBuffer(b), t)
t.areaHead = cast[PAreaInfo](getBuffer(ib))
t.used_size = memPoolSize - (b.size and blockSize)
t.max_size = t.used_size
# XXX

187
lib/mm.nim Normal file
View file

@ -0,0 +1,187 @@
#
#
# Nimrod's Runtime Library
# (c) Copyright 2009 Andreas Rumpf
#
# See the file "copying.txt", included in this
# distribution, for details about the copyright.
#
# Nimrod high-level memory manager: It supports Boehm's GC, no GC and the
# native Nimrod GC. The native Nimrod GC is the default.
#{.push checks:on, assertions:on.}
{.push checks:off.}
const
debugGC = false # we wish to debug the GC...
logGC = false
traceGC = false # extensive debugging
reallyDealloc = true # for debugging purposes this can be set to false
cycleGC = true # (de)activate the cycle GC
stressGC = false
reallyOsDealloc = true
coalescRight = true
coalescLeft = true
type
PPointer = ptr pointer
TByteArray = array[0..1000_0000, byte]
PByte = ptr TByteArray
PString = ptr string
# Page size of the system; in most cases 4096 bytes. For exotic OS or
# CPU this needs to be changed:
const
PageShift = 12
PageSize = 1 shl PageShift
PageMask = PageSize-1
MemAlign = 8 # also minimal allocatable memory block
BitsPerPage = PageSize div MemAlign
UnitsPerPage = BitsPerPage div (sizeof(int)*8)
# how many ints do we need to describe a page:
# on 32 bit systems this is only 16 (!)
TrunkShift = 9
BitsPerTrunk = 1 shl TrunkShift # needs to be power of 2 and divisible by 64
TrunkMask = BitsPerTrunk - 1
IntsPerTrunk = BitsPerTrunk div (sizeof(int)*8)
IntShift = 5 + ord(sizeof(int) == 8) # 5 or 6, depending on int width
IntMask = 1 shl IntShift - 1
var
gOutOfMem: ref EOutOfMemory
proc raiseOutOfMem() {.noreturn.} =
if gOutOfMem == nil: quit("out of memory; cannot even throw an exception")
gOutOfMem.msg = "out of memory"
raise gOutOfMem
when defined(boehmgc):
when defined(windows):
const boehmLib = "boehmgc.dll"
else:
const boehmLib = "/usr/lib/libgc.so.1"
proc boehmGC_disable {.importc: "GC_disable", dynlib: boehmLib.}
proc boehmGC_enable {.importc: "GC_enable", dynlib: boehmLib.}
proc boehmGCincremental {.
importc: "GC_enable_incremental", dynlib: boehmLib.}
proc boehmGCfullCollect {.importc: "GC_gcollect", dynlib: boehmLib.}
proc boehmAlloc(size: int): pointer {.
importc: "GC_malloc", dynlib: boehmLib.}
proc boehmAllocAtomic(size: int): pointer {.
importc: "GC_malloc_atomic", dynlib: boehmLib.}
proc boehmRealloc(p: pointer, size: int): pointer {.
importc: "GC_realloc", dynlib: boehmLib.}
proc boehmDealloc(p: pointer) {.importc: "GC_free", dynlib: boehmLib.}
proc alloc(size: int): pointer =
result = boehmAlloc(size)
if result == nil: raiseOutOfMem()
proc alloc0(size: int): pointer =
result = alloc(size)
zeroMem(result, size)
proc realloc(p: Pointer, newsize: int): pointer =
result = boehmRealloc(p, newsize)
if result == nil: raiseOutOfMem()
proc dealloc(p: Pointer) =
boehmDealloc(p)
proc initGC() = nil
#boehmGCincremental()
proc GC_disable() = boehmGC_disable()
proc GC_enable() = boehmGC_enable()
proc GC_fullCollect() = boehmGCfullCollect()
proc GC_setStrategy(strategy: TGC_Strategy) = nil
proc GC_enableMarkAndSweep() = nil
proc GC_disableMarkAndSweep() = nil
proc GC_getStatistics(): string = return ""
proc getOccupiedMem(): int = return -1
proc getFreeMem(): int = return -1
proc getTotalMem(): int = return -1
proc newObj(typ: PNimType, size: int): pointer {.compilerproc.} =
result = alloc(size)
proc newSeq(typ: PNimType, len: int): pointer {.compilerproc.} =
result = newObj(typ, addInt(mulInt(len, typ.base.size), GenericSeqSize))
cast[PGenericSeq](result).len = len
cast[PGenericSeq](result).space = len
proc growObj(old: pointer, newsize: int): pointer =
result = realloc(old, newsize)
proc setStackBottom(theStackBottom: pointer) {.compilerproc.} = nil
proc nimGCref(p: pointer) {.compilerproc, inline.} = nil
proc nimGCunref(p: pointer) {.compilerproc, inline.} = nil
proc unsureAsgnRef(dest: ppointer, src: pointer) {.compilerproc, inline.} =
dest^ = src
proc asgnRef(dest: ppointer, src: pointer) {.compilerproc, inline.} =
dest^ = src
proc asgnRefNoCycle(dest: ppointer, src: pointer) {.compilerproc, inline.} =
dest^ = src
include cellsets
elif defined(nogc):
proc alloc(size: int): pointer =
result = c_malloc(size)
if result == nil: raiseOutOfMem()
proc alloc0(size: int): pointer =
result = alloc(size)
zeroMem(result, size)
proc realloc(p: Pointer, newsize: int): pointer =
result = c_realloc(p, newsize)
if result == nil: raiseOutOfMem()
proc dealloc(p: Pointer) =
c_free(p)
proc initGC() = nil
proc GC_disable() = nil
proc GC_enable() = nil
proc GC_fullCollect() = nil
proc GC_setStrategy(strategy: TGC_Strategy) = nil
proc GC_enableMarkAndSweep() = nil
proc GC_disableMarkAndSweep() = nil
proc GC_getStatistics(): string = return ""
proc getOccupiedMem(): int = return -1
proc getFreeMem(): int = return -1
proc getTotalMem(): int = return -1
proc newObj(typ: PNimType, size: int): pointer {.compilerproc.} =
result = alloc0(size)
proc newSeq(typ: PNimType, len: int): pointer {.compilerproc.} =
result = newObj(typ, addInt(mulInt(len, typ.base.size), GenericSeqSize))
cast[PGenericSeq](result).len = len
cast[PGenericSeq](result).space = len
proc growObj(old: pointer, newsize: int): pointer =
result = realloc(old, newsize)
# XXX BUG: we need realloc0 here, but C does not support this...
proc setStackBottom(theStackBottom: pointer) {.compilerproc.} = nil
proc nimGCref(p: pointer) {.compilerproc, inline.} = nil
proc nimGCunref(p: pointer) {.compilerproc, inline.} = nil
proc unsureAsgnRef(dest: ppointer, src: pointer) {.compilerproc, inline.} =
dest^ = src
proc asgnRef(dest: ppointer, src: pointer) {.compilerproc, inline.} =
dest^ = src
proc asgnRefNoCycle(dest: ppointer, src: pointer) {.compilerproc, inline.} =
dest^ = src
include cellsets
else:
include alloc
include cellsets
assert(sizeof(TCell) == sizeof(TFreeCell))
include gc
{.pop.}

2
lib/os.nim
View file

@ -546,7 +546,7 @@ proc getApplicationFilename(): string =
# Solaris:
# /proc/<pid>/object/a.out (filename only)
# /proc/<pid>/path/a.out (complete pathname)
# *BSD (and maybe Darwing too):
# *BSD (and maybe Darwin too):
# /proc/<pid>/file
when defined(windows):
result = newString(256)

92
lib/osproc.nim
View file

@ -1,20 +1,21 @@
#
#
# Nimrod's Runtime Library
# (c) Copyright 2008 Andreas Rumpf
# (c) Copyright 2009 Andreas Rumpf
#
# See the file "copying.txt", included in this
# distribution, for details about the copyright.
#
## This module implements an advanced facility for executing OS processes.
## On Windows this module is currently broken. Please help!
## This module implements an advanced facility for executing OS processes
## and process communication.
## **On Windows this module does not work properly. Please help!**
import
os, strtabs, streams
when defined(windows):
import windows
import winlean
type
TProcess = object of TObject
@ -41,6 +42,10 @@ proc executeProcess*(command: string,
## A convience procedure that executes ``command`` with ``startProcess``
## and returns its output as a string.
proc executeCommand*(command: string): int
## Executes ``command`` and returns its error code. Standard input, output,
## error streams are inherited from the calling process.
proc startProcess*(command: string,
workingDir: string = "",
args: openarray[string] = [],
@ -133,14 +138,14 @@ when defined(Windows):
proc hsReadData(s: PFileHandleStream, buffer: pointer, bufLen: int): int =
var br: int32
var a = windows.ReadFile(s.handle, buffer, bufLen, br, nil)
var a = winlean.ReadFile(s.handle, buffer, bufLen, br, nil)
if a == 0: OSError()
result = br
#atEnd = bytesRead < bufLen
proc hsWriteData(s: PFileHandleStream, buffer: pointer, bufLen: int) =
var bytesWritten: int32
var a = windows.writeFile(s.handle, buffer, bufLen, bytesWritten, nil)
var a = winlean.writeFile(s.handle, buffer, bufLen, bytesWritten, nil)
if a == 0: OSError()
proc newFileHandleStream(handle: THandle): PFileHandleStream =
@ -180,12 +185,12 @@ when defined(Windows):
# O_WRONLY {.importc: "_O_WRONLY", header: "<fcntl.h>".}: int
# O_RDONLY {.importc: "_O_RDONLY", header: "<fcntl.h>".}: int
proc CreatePipeHandles(Inhandle, OutHandle: ptr THandle) =
proc CreatePipeHandles(Inhandle, OutHandle: var THandle) =
var piInheritablePipe: TSecurityAttributes
piInheritablePipe.nlength = SizeOF(TSecurityAttributes)
piInheritablePipe.lpSecurityDescriptor = Nil
piInheritablePipe.lpSecurityDescriptor = nil
piInheritablePipe.Binherithandle = 1
if CreatePipe(Inhandle, Outhandle, addr(piInheritablePipe), 0) == 0'i32:
if CreatePipe(Inhandle, Outhandle, piInheritablePipe, 0) == 0'i32:
OSError()
proc startProcess*(command: string,
@ -201,15 +206,15 @@ when defined(Windows):
hi, ho, he: THandle
SI.cb = SizeOf(SI)
SI.dwFlags = STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES
CreatePipeHandles(addr(SI.hStdInput), addr(HI))
CreatePipeHandles(addr(HO), addr(Si.hStdOutput))
CreatePipeHandles(SI.hStdInput, HI)
CreatePipeHandles(HO, Si.hStdOutput)
#SI.hStdInput = GetStdHandle(STD_INPUT_HANDLE())
#SI.hStdOutput = GetStdHandle(STD_OUTPUT_HANDLE())
if poStdErrToStdOut in options:
SI.hStdError = SI.hStdOutput
HE = HO
else:
CreatePipeHandles(addr(HE), addr(Si.hStdError))
CreatePipeHandles(HE, Si.hStdError)
#SI.hStdError = GetStdHandle(STD_ERROR_HANDLE())
#result.inputHandle = open_osfhandle(HI, O_WRONLY)
#if result.inputHandle == -1'i32: OSError()
@ -224,16 +229,12 @@ when defined(Windows):
var wd: cstring = nil
if len(workingDir) > 0: wd = workingDir
if env == nil:
success = Windows.CreateProcess(nil,
cmdl, nil, nil, 0,
NORMAL_PRIORITY_CLASS, nil, wd,
addr(SI), addr(ProcInfo))
success = winlean.CreateProcess(nil,
cmdl, nil, nil, 0, NORMAL_PRIORITY_CLASS, nil, wd, SI, ProcInfo)
else:
var e = buildEnv(env)
success = Windows.CreateProcess(nil,
cmdl, nil, nil, 0,
NORMAL_PRIORITY_CLASS, e, wd,
addr(SI), addr(ProcInfo))
success = winlean.CreateProcess(nil,
cmdl, nil, nil, 0, NORMAL_PRIORITY_CLASS, e, wd, SI, ProcInfo)
dealloc(e)
dealloc(cmdl)
if success == 0:
@ -249,7 +250,7 @@ when defined(Windows):
discard ResumeThread(p.FThreadHandle)
proc running(p: PProcess): bool =
var x = waitForSingleObject(p.FThreadHandle, 50)
var x = waitForSingleObject(p.FProcessHandle, 50)
return x == WAIT_TIMEOUT
proc terminate(p: PProcess) =
@ -257,11 +258,11 @@ when defined(Windows):
discard TerminateProcess(p.FProcessHandle, 0)
proc waitForExit(p: PProcess): int =
discard WaitForSingleObject(p.FThreadHandle, Infinite)
var res: dword
discard CloseHandle(p.FThreadHandle)
discard WaitForSingleObject(p.FProcessHandle, Infinite)
var res: int32
discard GetExitCodeProcess(p.FProcessHandle, res)
result = res
discard CloseHandle(p.FThreadHandle)
discard CloseHandle(p.FProcessHandle)
proc inputStream(p: PProcess): PStream =
@ -273,6 +274,29 @@ when defined(Windows):
proc errorStream(p: PProcess): PStream =
result = newFileHandleStream(p.errorHandle)
proc executeCommand(command: string): int =
var
SI: TStartupInfo
ProcInfo: TProcessInformation
process: THandle
L: int32
SI.cb = SizeOf(SI)
SI.hStdError = GetStdHandle(STD_ERROR_HANDLE)
SI.hStdInput = GetStdHandle(STD_INPUT_HANDLE)
SI.hStdOutput = GetStdHandle(STD_OUTPUT_HANDLE)
if winlean.CreateProcess(nil, command, nil, nil, 0,
NORMAL_PRIORITY_CLASS, nil, nil, SI, ProcInfo) == 0:
OSError()
else:
Process = ProcInfo.hProcess
discard CloseHandle(ProcInfo.hThread)
if WaitForSingleObject(Process, INFINITE) != -1:
discard GetExitCodeProcess(Process, L)
result = int(L)
else:
result = -1
discard CloseHandle(Process)
else:
import posix
@ -321,15 +345,15 @@ else:
if pid == 0:
## child process:
discard close(p_stdin[writeIdx])
discard dup2(p_stdin[readIdx], readIdx)
if dup2(p_stdin[readIdx], readIdx) < 0: OSError()
discard close(p_stdout[readIdx])
discard dup2(p_stdout[writeIdx], writeIdx)
if dup2(p_stdout[writeIdx], writeIdx) < 0: OSError()
if poStdErrToStdOut in options:
discard dup2(p_stdout[writeIdx], 2)
if dup2(p_stdout[writeIdx], 2) < 0: OSError()
else:
if pipe(p_stderr) != 0'i32: OSError("failed to create a pipe")
discard close(p_stderr[readIdx])
discard dup2(p_stderr[writeIdx], 2)
if dup2(p_stderr[writeIdx], 2) < 0: OSError()
if workingDir.len > 0:
os.setCurrentDir(workingDir)
@ -347,8 +371,7 @@ else:
else:
discard execve("/bin/sh", a, ToCStringArray(env))
# too risky to raise an exception here:
echo("execve call failed: " & $strerror(errno))
quit(1)
quit("execve call failed: " & $strerror(errno))
# Parent process. Copy process information.
result.id = pid
@ -376,6 +399,7 @@ else:
if running(p): discard kill(p.id, SIGKILL)
proc waitForExit(p: PProcess): int =
result = 1
if waitPid(p.id, p.exitCode, 0) == int(p.id):
result = p.exitCode
@ -393,3 +417,11 @@ else:
var f: TFile
if not openFile(f, p.errorHandle, fmRead): OSError()
result = newFileStream(f)
proc csystem(cmd: cstring): cint {.nodecl, importc: "system".}
proc executeCommand(command: string): int =
result = csystem(command)
when isMainModule:
echo executeCommand("gcc -v")

176
lib/parsecsv.nim Normal file
View file

@ -0,0 +1,176 @@
#
#
# Nimrod's Runtime Library
# (c) Copyright 2009 Andreas Rumpf
#
# See the file "copying.txt", included in this
# distribution, for details about the copyright.
#
## This module implements a simple high performance `CSV`:idx:
## (`comma separated value`:idx:) parser.
##
## Example: How to use the parser
## ==============================
##
## .. code-block:: nimrod
## import os, parsecsv, streams
## var s = newFileStream(ParamStr(1), fmRead)
## if s == nil: quit("cannot open the file" & ParamStr(1))
## var x: TCsvParser
## open(x, s, ParamStr(1))
## while readRow(x):
## Echo "new row: "
## for val in items(x.row):
## Echo "##", val, "##"
## close(x)
##
import
lexbase, streams
type
TCsvRow* = seq[string] ## a row in a CSV file
TCsvParser* = object of TBaseLexer ## the parser object.
row*: TCsvRow ## the current row
filename: string
sep, quote, esc: char
skipWhite: bool
currRow: int
EInvalidCsv* = object of EIO ## exception that is raised if
## a parsing error occurs
proc raiseEInvalidCsv(filename: string, line, col: int,
msg: string) {.noreturn.} =
var e: ref EInvalidCsv
new(e)
e.msg = filename & "(" & $line & ", " & $col & ") Error: " & msg
raise e
proc error(my: TCsvParser, pos: int, msg: string) =
raiseEInvalidCsv(my.filename, my.LineNumber, getColNumber(my, pos), msg)
proc open*(my: var TCsvParser, input: PStream, filename: string,
separator = ',', quote = '"', escape = '\0',
skipInitialSpace = false) =
## initializes the parser with an input stream. `Filename` is only used
## for nice error messages. The parser's behaviour can be controlled by
## the diverse optional parameters:
## - `separator`: character used to separate fields
## - `quote`: Used to quote fields containing special characters like
## `separator`, `quote` or new-line characters. '\0' disables the parsing
## of quotes.
## - `escape`: removes any special meaning from the following character;
## '\0' disables escaping; if escaping is disabled and `quote` is not '\0',
## two `quote` characters are parsed one literal `quote` character.
## - `skipInitialSpace`: If true, whitespace immediately following the
## `separator` is ignored.
lexbase.open(my, input)
my.filename = filename
my.sep = separator
my.quote = quote
my.esc = escape
my.skipWhite = skipInitialSpace
my.row = @[]
my.currRow = 0
proc parseField(my: var TCsvParser, a: var string) =
var pos = my.bufpos
var buf = my.buf
if my.skipWhite:
while buf[pos] in {' ', '\t'}: inc(pos)
setLen(a, 0) # reuse memory
if buf[pos] == my.quote and my.quote != '\0':
inc(pos)
while true:
var c = buf[pos]
if c == '\0':
my.bufpos = pos # can continue after exception?
error(my, pos, my.quote & " expected")
break
elif c == my.quote:
if my.esc == '\0' and buf[pos+1] == my.quote:
add(a, my.quote)
inc(pos, 2)
else:
inc(pos)
break
elif c == my.esc:
add(a, buf[pos+1])
inc(pos, 2)
else:
case c
of '\c':
pos = handleCR(my, pos)
add(a, "\n")
of '\l':
pos = handleLF(my, pos)
add(a, "\n")
else:
add(a, c)
inc(pos)
else:
while true:
var c = buf[pos]
if c == my.sep: break
if c in {'\c', '\l', '\0'}: break
add(a, c)
inc(pos)
my.bufpos = pos
proc processedRows*(my: var TCsvParser): int =
## returns number of the processed rows
return my.currRow
proc readRow*(my: var TCsvParser, columns = 0): bool =
## reads the next row; if `columns` > 0, it expects the row to have
## exactly this many columns. Returns false if the end of the file
## has been encountered else true.
var col = 0 # current column
var oldpos = my.bufpos
while my.buf[my.bufpos] != '\0':
var oldlen = my.row.len
if oldlen < col+1:
setLen(my.row, col+1)
my.row[col] = ""
parseField(my, my.row[col])
inc(col)
if my.buf[my.bufpos] == my.sep:
inc(my.bufpos)
else:
case my.buf[my.bufpos]
of '\c', '\l':
# skip empty lines:
while true:
case my.buf[my.bufpos]
of '\c': my.bufpos = handleCR(my, my.bufpos)
of '\l': my.bufpos = handleLF(my, my.bufpos)
else: break
of '\0': nil
else: error(my, my.bufpos, my.sep & " expected")
break
setlen(my.row, col)
result = col > 0
if result and col != columns and columns > 0:
error(my, oldpos+1, $columns & " columns expected, but found " &
$col & " columns")
inc(my.currRow)
proc close*(my: var TCsvParser) {.inline.} =
## closes the parser `my` and its associated input stream.
lexbase.close(my)
when isMainModule:
import os
var s = newFileStream(ParamStr(1), fmRead)
if s == nil: quit("cannot open the file" & ParamStr(1))
var x: TCsvParser
open(x, s, ParamStr(1))
while readRow(x):
Echo "new row: "
for val in items(x.row):
Echo "##", val, "##"
close(x)

2
lib/parsexml.nim
View file

@ -22,7 +22,7 @@
## * Thus the checks would have been very difficult to implement properly with
## little benefit, especially since they are simple to implement in the
## client. The client should use the `errorMsgExpected` proc to generate
## a nice error message that fits to the other error messages this library
## a nice error message that fits the other error messages this library
## creates.
##
##

205
lib/ptrset.nim
View file

@ -1,205 +0,0 @@
# This implements a new pointer set. Access time O(1). For 32 bit systems, we
# currently need 3 memory accesses.
const
PageSize = 1024 * sizeof(int)
MemAlignment = 8 # minimal memory block that can be allocated
BitsPerUnit = sizeof(int)*8
# a "unit" is a word, i.e. 4 bytes
# on a 32 bit system; I do not use the term "word" because under 32-bit
# Windows it is sometimes only 16 bits
BitsPerPage = PageSize div MemAlignment
UnitsPerPage = BitsPerPage div BitsPerUnit
# how many units do we need to describe a page:
# on 32 bit systems this is only 16 (!)
type
PPointer = ptr pointer
TCollectorData = int
TCell {.final.} = object
refcount: TCollectorData # the refcount and bit flags
typ: PNimType
stackcount: int # stack counter for debugging
drefc: int # real reference counter for debugging
PCell = ptr TCell
proc cellToUsr(cell: PCell): pointer {.inline.} =
# convert object (=pointer to refcount) to pointer to userdata
result = cast[pointer](cast[TAddress](cell)+%TAddress(sizeof(TCell)))
proc usrToCell(usr: pointer): PCell {.inline.} =
# convert pointer to userdata to object (=pointer to refcount)
result = cast[PCell](cast[TAddress](usr)-%TAddress(sizeof(TCell)))
proc gcAlloc(size: int): pointer =
result = alloc0(size)
if result == nil: raiseOutOfMem()
# ------------------ Zero count table (ZCT) and any table (AT) -------------
# this that has to equals zero, otherwise we have to round up UnitsPerPage:
when BitsPerPage mod BitsPerUnit != 0:
{.error: "(BitsPerPage mod BitsPerUnit) should be zero!".}
# ------------------- cell set handling ------------------------------
# A cellset consists of a hash table of page descriptors. A page
# descriptor has a bit for
# every Memalignment'th byte in the page.
# However, only bits corresponding to addresses that start memory blocks
# are set.
# Page descriptors are also linked to a list; the list
# is used for easy traversing of all page descriptors; this allows a
# fast iterator.
# We use a specialized hashing scheme; the formula is :
# hash = Page bitand max
# We use linear probing with the formular: (5*h)+1
# Thus we likely get no collisions at all if the pages are given to us
# in a sequential manner by the operating system!
const
bitsPerNode = 10 # we use 10 bits per node; this means 3 memory accesses on
# 32 bit systems
type
PPageDesc = ptr TPageDesc
TBitIndex = range[0..UnitsPerPage-1]
TPageDesc {.final.} = object
next: PPageDesc # all nodes are connected with this pointer
key: TAddress # start address at bit 0
bits: array[TBitIndex, int] # a bit vector
PPageDescArray = ptr array[0..1000_000, PPageDesc]
TCellSet {.final.} = object
counter, max: int
head: PPageDesc
data: PPageDescArray
TSetNode {.final.} = object
n: array[0.. (1 shl bitsPerNode)-1, PSetNode]
PSetNode = ptr TSetNode
const
InitCellSetSize = 1024 # must be a power of two!
proc CellSetInit(s: var TCellSet) =
s.data = gcAlloc(InitCellSetSize * sizeof(PPageDesc))
s.max = InitCellSetSize-1
s.counter = 0
s.head = nil
proc CellSetDeinit(s: var TCellSet) =
var it = s.head
while it != nil:
var n = it.next
dealloc(it)
it = n
s.head = nil # play it safe here
dealloc(s.data)
s.data = nil
s.counter = 0
proc CellSetGet(t: TCellSet, key: TAddress): PPageDesc =
var h = cast[int](key) and t.max
while t.data[h] != nil:
if t.data[h].key == key: return t.data[h]
h = nextTry(h, t.max)
return nil
proc CellSetRawInsert(t: TCellSet, data: PPageDescArray,
desc: PPageDesc) =
var h = cast[int](desc.key) and t.max
while data[h] != nil:
assert(data[h] != desc)
h = nextTry(h, t.max)
assert(data[h] == nil)
data[h] = desc
proc CellSetEnlarge(t: var TCellSet) =
var
n: PPageDescArray
oldMax = t.max
t.max = ((t.max+1)*2)-1
n = gcAlloc((t.max + 1) * sizeof(PPageDesc))
for i in 0 .. oldmax:
if t.data[i] != nil:
CellSetRawInsert(t, n, t.data[i])
dealloc(t.data)
t.data = n
proc CellSetPut(t: var TCellSet, key: TAddress): PPageDesc =
var h = cast[int](key) and t.max
while true:
var x = t.data[h]
if x == nil: break
if x.key == key: return x
h = nextTry(h, t.max)
if (t.max+1) * 2 < t.counter * 3: CellSetEnlarge(t)
inc(t.counter)
h = cast[int](key) and t.max
while t.data[h] != nil: h = nextTry(h, t.max)
assert(t.data[h] == nil)
# the new page descriptor goes into result
result = gcAlloc(sizeof(TPageDesc))
result.next = t.head
result.key = key
t.head = result
t.data[h] = result
# ---------- slightly higher level procs ----------------------------------
proc in_Operator(s: TCellSet, cell: PCell): bool =
var
u: TAddress
t: PPageDesc
u = cast[TAddress](cell)
t = CellSetGet(s, u /% PageSize)
if t != nil:
u = (u %% PageSize) /% MemAlignment
result = (t.bits[u /% BitsPerUnit] and (1 shl (u %% BitsPerUnit))) != 0
else:
result = false
proc incl(s: var TCellSet, cell: PCell) =
var
u: TAddress
t: PPageDesc
u = cast[TAddress](cell)
t = CellSetPut(s, u /% PageSize)
u = (u %% PageSize) /% MemAlignment
t.bits[u /% BitsPerUnit] = t.bits[u /% BitsPerUnit] or
(1 shl (u %% BitsPerUnit))
proc excl(s: var TCellSet, cell: PCell) =
var
u: TAddress
t: PPageDesc
u = cast[TAddress](cell)
t = CellSetGet(s, u /% PageSize)
if t != nil:
u = (u %% PageSize) /% MemAlignment
t.bits[u %% BitsPerUnit] = (t.bits[u /% BitsPerUnit] and
not (1 shl (u %% BitsPerUnit)))
iterator elements(t: TCellSet): PCell {.inline.} =
# while traversing it is forbidden to add pointers to the tree!
var r = t.head
while r != nil:
var i = 0
while i <= high(r.bits):
var w = r.bits[i] # taking a copy of r.bits[i] here is correct, because
# modifying operations are not allowed during traversation
var j = 0
while w != 0: # test all remaining bits for zero
if (w and 1) != 0: # the bit is set!
yield cast[PCell]((r.key *% PageSize) +%
(i*%BitsPerUnit+%j) *% MemAlignment)
inc(j)
w = w shr 1
inc(i)
r = r.next

6
lib/repr.nim
View file

@ -104,7 +104,7 @@ proc reprSet(p: pointer, typ: PNimType): string {.compilerproc.} =
type
TReprClosure {.final.} = object # we cannot use a global variable here
# as this wouldn't be thread-safe
marked: TCellSeq
marked: TCellSet
recdepth: int # do not recurse endless
indent: int # indentation
@ -171,14 +171,14 @@ proc reprRecord(result: var string, p: pointer, typ: PNimType,
proc reprRef(result: var string, p: pointer, typ: PNimType,
cl: var TReprClosure) =
# we know that p is not nil here:
when defined(boehmGC):
when defined(boehmGC) or defined(nogc):
var cell = cast[PCell](p)
else:
var cell = usrToCell(p)
add result, "ref " & reprPointer(p)
if cell notin cl.marked:
# only the address is shown:
add(cl.marked, cell)
incl(cl.marked, cell)
add result, " --> "
reprAux(result, p, typ.base, cl)

9
lib/strutils.nim
View file

@ -865,6 +865,15 @@ proc validEmailAddress*(s: string): bool =
"aero", "jobs", "museum": return true
return false
proc validIdentifier*(s: string): bool =
## returns true if `s` is a valid identifier. A valid identifier starts
## with a character of the set `IdentStartChars` and is followed by any
## number of characters of the set `IdentChars`.
if s[0] in IdentStartChars:
for i in 1..s.len-1:
if s[i] notin IdentChars: return false
return true
proc editDistance*(a, b: string): int =
## returns the edit distance between `a` and `b`. This uses the Levenshtein
## distance algorithm with only a linear memory overhead. This implementation

9
lib/sysio.nim
View file

@ -1,7 +1,7 @@
#
#
# Nimrod's Runtime Library
# (c) Copyright 2006 Andreas Rumpf
# (c) Copyright 2009 Andreas Rumpf
#
# See the file "copying.txt", included in this
# distribution, for details about the copyright.
@ -54,7 +54,12 @@ proc readLine(f: TFile): string =
rawReadLine(f, result)
proc write(f: TFile, s: string) = fputs(s, f)
proc write(f: TFile, i: int) = fprintf(f, "%ld", i)
proc write(f: TFile, i: int) =
when sizeof(int) == 8:
fprintf(f, "%lld", i)
else:
fprintf(f, "%ld", i)
proc write(f: TFile, b: bool) =
if b: write(f, "true")
else: write(f, "false")

23
lib/sysstr.nim
View file

@ -1,7 +1,7 @@
#
#
# Nimrod's Runtime Library
# (c) Copyright 2006 Andreas Rumpf
# (c) Copyright 2009 Andreas Rumpf
#
# See the file "copying.txt", included in this
# distribution, for details about the copyright.
@ -37,27 +37,20 @@ proc eqStrings(a, b: NimString): bool {.inline, compilerProc.} =
proc rawNewString(space: int): NimString {.compilerProc.} =
var s = space
if s < 8: s = 7
when defined(boehmGC):
result = cast[NimString](boehmAllocAtomic(
sizeof(TGenericSeq) + (s+1) * sizeof(char)))
result.len = 0
result.data[0] = '\0'
else:
result = cast[NimString](newObj(addr(strDesc), sizeof(TGenericSeq) +
(s+1) * sizeof(char)))
result = cast[NimString](newObj(addr(strDesc), sizeof(TGenericSeq) +
(s+1) * sizeof(char)))
result.space = s
proc mnewString(len: int): NimString {.exportc.} =
#c_fprintf(c_stdout, "[NEWSTRING] len: %ld\n", len)
result = rawNewString(len)
result.len = len
when defined(boehmGC):
result.data[len] = '\0'
proc toNimStr(str: CString, len: int): NimString {.compilerProc.} =
result = rawNewString(len)
result.len = len
c_memcpy(result.data, str, (len+1) * sizeof(Char))
result.data[len] = '\0' # IO.readline relies on this!
result.data[len] = '\0' # readline relies on this!
proc cstrToNimstr(str: CString): NimString {.compilerProc.} =
return toNimstr(str, c_strlen(str))
@ -184,9 +177,9 @@ proc setLengthStr(s: NimString, newLen: int): NimString {.compilerProc.} =
proc incrSeq(seq: PGenericSeq, elemSize: int): PGenericSeq {.compilerProc.} =
# increments the length by one:
# this is needed for supporting the &= operator;
# this is needed for supporting ``add``;
#
# add seq x generates:
# add(seq, x) generates:
# seq = incrSeq(seq, sizeof(x));
# seq[seq->len-1] = x;
when false:
@ -229,7 +222,7 @@ proc setLengthSeq(seq: PGenericSeq, elemSize, newLen: int): PGenericSeq {.
GenericSeqSize))
elif newLen < result.len:
# we need to decref here, otherwise the GC leaks!
when not defined(boehmGC):
when not defined(boehmGC) and not defined(nogc):
for i in newLen..result.len-1:
forAllChildrenAux(cast[pointer](cast[TAddress](result) +%
GenericSeqSize +% (i*%elemSize)),

98
lib/system.nim
View file

@ -1,7 +1,7 @@
#
#
# Nimrod's Runtime Library
# (c) Copyright 2008 Andreas Rumpf
# (c) Copyright 2009 Andreas Rumpf
#
# See the file "copying.txt", included in this
# distribution, for details about the copyright.
@ -415,11 +415,11 @@ proc `<=` *(x, y: int32): bool {.magic: "LeI", noSideEffect.}
proc `<=` *(x, y: int64): bool {.magic: "LeI64", noSideEffect.}
## Returns true iff `x` is less than or equal to `y`.
proc `<` *(x, y: int): bool {.magic: "LtI", noSideEffect.}
proc `<` *(x, y: int8): bool {.magic: "LtI", noSideEffect.}
proc `<` *(x, y: int16): bool {.magic: "LtI", noSideEffect.}
proc `<` *(x, y: int32): bool {.magic: "LtI", noSideEffect.}
proc `<` *(x, y: int64): bool {.magic: "LtI64", noSideEffect.}
proc `<` *(x, y: int): bool {.magic: "LtI", noSideEffect.}
proc `<` *(x, y: int8): bool {.magic: "LtI", noSideEffect.}
proc `<` *(x, y: int16): bool {.magic: "LtI", noSideEffect.}
proc `<` *(x, y: int32): bool {.magic: "LtI", noSideEffect.}
proc `<` *(x, y: int64): bool {.magic: "LtI64", noSideEffect.}
## Returns true iff `x` is less than `y`.
proc abs*(x: int): int {.magic: "AbsI", noSideEffect.}
@ -790,9 +790,10 @@ proc addQuitProc*(QuitProc: proc {.noconv.}) {.importc: "atexit", nodecl.}
# In case of an unhandled exeption the exit handlers should
# not be called explicitly! The user may decide to do this manually though.
proc copy*(s: string, first = 0): string {.importc: "copyStr", noSideEffect.}
proc copy*(s: string, first, last: int): string {.importc: "copyStrLast",
noSideEffect.}
proc copy*(s: string, first = 0): string {.
magic: "CopyStr", importc: "copyStr", noSideEffect.}
proc copy*(s: string, first, last: int): string {.
magic: "CopyStrLast", importc: "copyStrLast", noSideEffect.}
## copies a slice of `s` into a new string and returns this new
## string. The bounds `first` and `last` denote the indices of
## the first and last characters that shall be copied. If ``last``
@ -803,7 +804,8 @@ proc setLen*(s: var string, newlen: int) {.magic: "SetLengthStr".}
## If the current length is greater than the new length,
## ``s`` will be truncated.
proc newString*(len: int): string {.importc: "mnewString", noSideEffect.}
proc newString*(len: int): string {.
magic: "NewString", importc: "mnewString", noSideEffect.}
## returns a new string of length ``len`` but with uninitialized
## content. One needs to fill the string character after character
## with the index operator ``s[i]``. This procedure exists only for
@ -835,30 +837,23 @@ proc equalMem*(a, b: Pointer, size: int): bool {.
## otherwise. Like any procedure dealing with raw memory this is
## *unsafe*.
const
mallocHeader = "<stdlib.h>"
proc alloc*(size: int): pointer {.
importc: "malloc", header: mallocHeader, noconv.}
proc alloc*(size: int): pointer {.noconv.}
## 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!
proc alloc0*(size: int): pointer {.
importc: "ALLOC_0", header: mallocHeader, noconv.}
proc alloc0*(size: int): pointer {.noconv.}
## 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``.
proc realloc*(p: Pointer, newsize: int): pointer {.
importc: "realloc", header: mallocHeader, noconv.}
proc realloc*(p: Pointer, newsize: int): pointer {.noconv.}
## 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**
## ``realloc`` calls ``dealloc(p)``. In other cases the block has to
## be freed with ``dealloc``.
proc dealloc*(p: Pointer) {.
importc: "free", header: mallocHeader, noconv.}
proc dealloc*(p: Pointer) {.noconv.}
## 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
@ -1436,66 +1431,7 @@ when not defined(EcmaScript) and not defined(NimrodVM):
else:
result = n.sons[n.len]
when defined(boehmgc):
const
boehmLib = "/opt/lib/libgc.so"
proc boehmGC_disable {.importc: "GC_disable", dynlib: boehmLib.}
proc boehmGC_enable {.importc: "GC_enable", dynlib: boehmLib.}
proc boehmGCincremental {.
importc: "GC_enable_incremental", dynlib: boehmLib.}
proc boehmGCfullCollect {.importc: "GC_gcollect", dynlib: boehmLib.}
proc boehmAlloc(size: int): pointer {.
importc: "GC_malloc", dynlib: boehmLib.}
proc boehmAllocAtomic(size: int): pointer {.
importc: "GC_malloc_atomic", dynlib: boehmLib.}
proc boehmRealloc(p: pointer, size: int): pointer {.
importc: "GC_realloc", dynlib: boehmLib.}
proc boehmDealloc(p: pointer) {.importc: "GC_free", dynlib: boehmLib.}
include cellsets
when defined(boehmGC):
proc initGC() = nil
#boehmGCincremental()
proc GC_disable() = boehmGC_disable()
proc GC_enable() = boehmGC_enable()
proc GC_fullCollect() = boehmGCfullCollect()
proc GC_setStrategy(strategy: TGC_Strategy) = nil
proc GC_enableMarkAndSweep() = nil
proc GC_disableMarkAndSweep() = nil
proc GC_getStatistics(): string = return ""
proc getOccupiedMem(): int = return -1
proc getFreeMem(): int = return -1
proc getTotalMem(): int = return -1
proc growObj(old: pointer, newsize: int): pointer {.inline.} =
result = boehmRealloc(old, newsize)
proc newObj(size: int): pointer {.compilerproc.} =
result = boehmAlloc(size)
proc newSeq(baseSize, len: int): pointer {.compilerproc.} =
# XXX: overflow checks!
result = newObj(len * baseSize + GenericSeqSize)
cast[PGenericSeq](result).len = len
cast[PGenericSeq](result).space = len
proc setStackBottom(theStackBottom: pointer) {.compilerproc.} = nil
proc nimGCref(p: pointer) {.compilerproc, inline.} = nil
proc nimGCunref(p: pointer) {.compilerproc, inline.} = nil
proc unsureAsgnRef(dest: ppointer, src: pointer) {.compilerproc, inline.} =
dest^ = src
proc asgnRef(dest: ppointer, src: pointer) {.compilerproc, inline.} =
dest^ = src
proc asgnRefNoCycle(dest: ppointer, src: pointer) {.compilerproc, inline.} =
dest^ = src
elif not defined(nogc):
include gc
include mm
include sysstr
include assign
include repr

2
lib/windows/windows.nim
View file

@ -3879,7 +3879,7 @@ const
SW_SHOWNORMAL* = 1
WPF_RESTORETOMAXIMIZED* = 2
WPF_SETMINPOSITION* = 1 # Sleep
INFINITE* = 0xFFFFFFFF # SystemParametersInfo
INFINITE* = -1'i32 # SystemParametersInfo
SPI_GETBEEP* = 1
SPI_SETBEEP* = 2
SPI_GETMOUSE* = 3

108
lib/winlean.nim Normal file
View file

@ -0,0 +1,108 @@
#
#
# Nimrod's Runtime Library
# (c) Copyright 2009 Andreas Rumpf
#
# See the file "copying.txt", included in this
# distribution, for details about the copyright.
#
## This module implements a small wrapper for some needed Win API procedures,
## so that the Nimrod compiler does not depend on the huge Windows module.
type
THandle* = int
WINBOOL* = int32
TSECURITY_ATTRIBUTES* {.final, pure.} = object
nLength*: int32
lpSecurityDescriptor*: pointer
bInheritHandle*: WINBOOL
TSTARTUPINFO* {.final, pure.} = object
cb*: int32
lpReserved*: cstring
lpDesktop*: cstring
lpTitle*: cstring
dwX*: int32
dwY*: int32
dwXSize*: int32
dwYSize*: int32
dwXCountChars*: int32
dwYCountChars*: int32
dwFillAttribute*: int32
dwFlags*: int32
wShowWindow*: int16
cbReserved2*: int16
lpReserved2*: pointer
hStdInput*: THANDLE
hStdOutput*: THANDLE
hStdError*: THANDLE
TPROCESS_INFORMATION* {.final, pure.} = object
hProcess*: THANDLE
hThread*: THANDLE
dwProcessId*: int32
dwThreadId*: int32
const
STARTF_USESHOWWINDOW* = 1'i32
STARTF_USESTDHANDLES* = 256'i32
HIGH_PRIORITY_CLASS* = 128'i32
IDLE_PRIORITY_CLASS* = 64'i32
NORMAL_PRIORITY_CLASS* = 32'i32
REALTIME_PRIORITY_CLASS* = 256'i32
WAIT_TIMEOUT* = 0x00000102'i32
INFINITE* = -1'i32
STD_INPUT_HANDLE* = -10'i32
STD_OUTPUT_HANDLE* = -11'i32
STD_ERROR_HANDLE* = -12'i32
proc CloseHandle*(hObject: THANDLE): WINBOOL {.stdcall, dynlib: "kernel32",
importc: "CloseHandle".}
proc ReadFile*(hFile: THandle, Buffer: pointer, nNumberOfBytesToRead: int32,
lpNumberOfBytesRead: var int32, lpOverlapped: pointer): WINBOOL{.
stdcall, dynlib: "kernel32", importc: "ReadFile".}
proc WriteFile*(hFile: THandle, Buffer: pointer, nNumberOfBytesToWrite: int32,
lpNumberOfBytesWritten: var int32,
lpOverlapped: pointer): WINBOOL{.
stdcall, dynlib: "kernel32", importc: "WriteFile".}
proc CreatePipe*(hReadPipe, hWritePipe: var THandle,
lpPipeAttributes: var TSECURITY_ATTRIBUTES,
nSize: int32): WINBOOL{.
stdcall, dynlib: "kernel32", importc: "CreatePipe".}
proc CreateProcess*(lpApplicationName, lpCommandLine: cstring,
lpProcessAttributes: ptr TSECURITY_ATTRIBUTES,
lpThreadAttributes: ptr TSECURITY_ATTRIBUTES,
bInheritHandles: WINBOOL, dwCreationFlags: int32,
lpEnvironment: pointer, lpCurrentDirectory: cstring,
lpStartupInfo: var TSTARTUPINFO,
lpProcessInformation: var TPROCESS_INFORMATION): WINBOOL{.
stdcall, dynlib: "kernel32", importc: "CreateProcessA".}
proc SuspendThread*(hThread: THANDLE): int32 {.stdcall, dynlib: "kernel32",
importc: "SuspendThread".}
proc ResumeThread*(hThread: THANDLE): int32 {.stdcall, dynlib: "kernel32",
importc: "ResumeThread".}
proc WaitForSingleObject*(hHandle: THANDLE, dwMilliseconds: int32): int32 {.
stdcall, dynlib: "kernel32", importc: "WaitForSingleObject".}
proc TerminateProcess*(hProcess: THANDLE, uExitCode: int): WINBOOL {.stdcall,
dynlib: "kernel32", importc: "TerminateProcess".}
proc GetExitCodeProcess*(hProcess: THANDLE, lpExitCode: var int32): WINBOOL {.
stdcall, dynlib: "kernel32", importc: "GetExitCodeProcess".}
proc GetStdHandle*(nStdHandle: int32): THANDLE {.stdcall, dynlib: "kernel32",
importc: "GetStdHandle".}
proc SetStdHandle*(nStdHandle: int32, hHandle: THANDLE): WINBOOL {.stdcall,
dynlib: "kernel32", importc: "SetStdHandle".}
proc FlushFileBuffers*(hFile: THANDLE): WINBOOL {.stdcall, dynlib: "kernel32",
importc: "FlushFileBuffers".}

1107
lib/wz_jsgraphics.js
View file

File diff suppressed because it is too large Load diff

406
lib/xmlgen.nim Normal file
View file

@ -0,0 +1,406 @@
#
#
# Nimrod's Runtime Library
# (c) Copyright 2009 Andreas Rumpf
#
# See the file "copying.txt", included in this
# distribution, for details about the copyright.
#
## This module implements a simple `XML`:idx: and `HTML`:idx: code
## generator. Each commonly used HTML tag has a corresponding macro
## that generates a string with its HTML representation.
##
## Example:
##
## .. code-block:: nimrod
## var nim = "Nimrod"
## echo h1(a(href="http://force7.de/nimrod", nim))
##
## Writes the string::
##
## <h1><a href="http://force7.de/nimrod">Nimrod</a></h1>
##
import
macros, strutils
const
coreAttr* = " id class title style "
eventAttr* = " onclick ondblclick onmousedown onmouseup " &
"onmouseover onmousemove onmouseout onkeypress onkeydown onkeyup "
commonAttr* = coreAttr & eventAttr
proc getIdent(e: PNimrodNode): string {.compileTime.} =
case e.kind
of nnkIdent: result = normalize($e.ident)
of nnkAccQuoted: result = getIdent(e[0])
else: error("cannot extract identifier from node: " & toStrLit(e).strVal)
proc delete[T](s: var seq[T], attr: T): bool =
var idx = find(s, attr)
if idx >= 0:
var L = s.len
s[idx] = s[L-1]
setLen(s, L-1)
result = true
proc xmlCheckedTag*(e: PNimrodNode, tag: string,
optAttr = "", reqAttr = "",
isLeaf = false): PNimrodNode {.compileTime.} =
## use this procedure to define a new XML tag
# copy the attributes; when iterating over them these lists
# will be modified, so that each attribute is only given one value
var req = splitSeq(reqAttr)
var opt = splitSeq(optAttr)
result = newNimNode(nnkBracket, e)
result.add(newStrLitNode("<"))
result.add(newStrLitNode(tag))
# first pass over attributes:
for i in 1..e.len-1:
if e[i].kind == nnkExprEqExpr:
var name = getIdent(e[i][0])
if delete(req, name) or delete(opt, name):
result.add(newStrLitNode(" "))
result.add(newStrLitNode(name))
result.add(newStrLitNode("=\""))
result.add(e[i][1])
result.add(newStrLitNode("\""))
else:
error("invalid attribute for '" & tag & "' element: " & name)
# check each required attribute exists:
if req.len > 0:
error(req[0] & " attribute for '" & tag & "' element expected")
if isLeaf:
for i in 1..e.len-1:
if e[i].kind != nnkExprEqExpr:
error("element " & tag & " cannot be nested")
result.add(newStrLitNode(" />"))
else:
result.add(newStrLitNode(">"))
# second pass over elements:
for i in 1..e.len-1:
if e[i].kind != nnkExprEqExpr: result.add(e[i])
result.add(newStrLitNode("</"))
result.add(newStrLitNode(tag))
result.add(newStrLitNode(">"))
result = NestList(!"&", result)
macro a*(e: expr): expr =
## generates the HTML ``a`` element.
result = xmlCheckedTag(e, "a", "href charset type hreflang rel rev " &
"accesskey tabindex" & commonAttr)
macro acronym*(e: expr): expr =
## generates the HTML ``acronym`` element.
result = xmlCheckedTag(e, "acronym", commonAttr)
macro address*(e: expr): expr =
## generates the HTML ``address`` element.
result = xmlCheckedTag(e, "address", commonAttr)
macro area*(e: expr): expr =
## generates the HTML ``area`` element.
result = xmlCheckedTag(e, "area", "shape coords href nohref" &
" accesskey tabindex" & commonAttr, "alt", true)
macro b*(e: expr): expr =
## generates the HTML ``b`` element.
result = xmlCheckedTag(e, "b", commonAttr)
macro base*(e: expr): expr =
## generates the HTML ``base`` element.
result = xmlCheckedTag(e, "base", "", "href", true)
macro big*(e: expr): expr =
## generates the HTML ``big`` element.
result = xmlCheckedTag(e, "big", commonAttr)
macro blockquote*(e: expr): expr =
## generates the HTML ``blockquote`` element.
result = xmlCheckedTag(e, "blockquote", " cite" & commonAttr)
macro body*(e: expr): expr =
## generates the HTML ``body`` element.
result = xmlCheckedTag(e, "body", commonAttr)
macro br*(e: expr): expr =
## generates the HTML ``br`` element.
result = xmlCheckedTag(e, "br", "", "", true)
macro button*(e: expr): expr =
## generates the HTML ``button`` element.
result = xmlCheckedTag(e, "button", "accesskey tabindex " &
"disabled name type value" & commonAttr)
macro caption*(e: expr): expr =
## generates the HTML ``caption`` element.
result = xmlCheckedTag(e, "caption", commonAttr)
macro cite*(e: expr): expr =
## generates the HTML ``cite`` element.
result = xmlCheckedTag(e, "cite", commonAttr)
macro code*(e: expr): expr =
## generates the HTML ``code`` element.
result = xmlCheckedTag(e, "code", commonAttr)
macro col*(e: expr): expr =
## generates the HTML ``col`` element.
result = xmlCheckedTag(e, "col", "span align valign" & commonAttr, "", true)
macro colgroup*(e: expr): expr =
## generates the HTML ``colgroup`` element.
result = xmlCheckedTag(e, "colgroup", "span align valign" & commonAttr)
macro dd*(e: expr): expr =
## generates the HTML ``dd`` element.
result = xmlCheckedTag(e, "dd", commonAttr)
macro del*(e: expr): expr =
## generates the HTML ``del`` element.
result = xmlCheckedTag(e, "del", "cite datetime" & commonAttr)
macro dfn*(e: expr): expr =
## generates the HTML ``dfn`` element.
result = xmlCheckedTag(e, "dfn", commonAttr)
macro `div`*(e: expr): expr =
## generates the HTML ``div`` element.
result = xmlCheckedTag(e, "div", commonAttr)
macro dl*(e: expr): expr =
## generates the HTML ``dl`` element.
result = xmlCheckedTag(e, "dl", commonAttr)
macro dt*(e: expr): expr =
## generates the HTML ``dt`` element.
result = xmlCheckedTag(e, "dt", commonAttr)
macro em*(e: expr): expr =
## generates the HTML ``em`` element.
result = xmlCheckedTag(e, "em", commonAttr)
macro fieldset*(e: expr): expr =
## generates the HTML ``fieldset`` element.
result = xmlCheckedTag(e, "fieldset", commonAttr)
macro form*(e: expr): expr =
## generates the HTML ``form`` element.
result = xmlCheckedTag(e, "form", "method encype accept accept-charset" &
commonAttr, "action")
macro h1*(e: expr): expr =
## generates the HTML ``h1`` element.
result = xmlCheckedTag(e, "h1", commonAttr)
macro h2*(e: expr): expr =
## generates the HTML ``h2`` element.
result = xmlCheckedTag(e, "h2", commonAttr)
macro h3*(e: expr): expr =
## generates the HTML ``h3`` element.
result = xmlCheckedTag(e, "h3", commonAttr)
macro h4*(e: expr): expr =
## generates the HTML ``h4`` element.
result = xmlCheckedTag(e, "h4", commonAttr)
macro h5*(e: expr): expr =
## generates the HTML ``h5`` element.
result = xmlCheckedTag(e, "h5", commonAttr)
macro h6*(e: expr): expr =
## generates the HTML ``h6`` element.
result = xmlCheckedTag(e, "h6", commonAttr)
macro head*(e: expr): expr =
## generates the HTML ``head`` element.
result = xmlCheckedTag(e, "head", "profile")
macro html*(e: expr): expr =
## generates the HTML ``html`` element.
result = xmlCheckedTag(e, "html", "", "xmlns")
macro hr*(e: expr): expr =
## generates the HTML ``hr`` element.
result = xmlCheckedTag(e, "hr", commonAttr, "", true)
macro i*(e: expr): expr =
## generates the HTML ``i`` element.
result = xmlCheckedTag(e, "i", commonAttr)
macro img*(e: expr): expr =
## generates the HTML ``img`` element.
result = xmlCheckedTag(e, "img", "longdesc height width", "src alt", true)
macro input*(e: expr): expr =
## generates the HTML ``input`` element.
result = xmlCheckedTag(e, "input", "name type value checked maxlength src" &
" alt accept disabled readonly accesskey tabindex" & commonAttr, "", true)
macro ins*(e: expr): expr =
## generates the HTML ``ins`` element.
result = xmlCheckedTag(e, "ins", "cite datetime" & commonAttr)
macro kbd*(e: expr): expr =
## generates the HTML ``kbd`` element.
result = xmlCheckedTag(e, "kbd", commonAttr)
macro label*(e: expr): expr =
## generates the HTML ``label`` element.
result = xmlCheckedTag(e, "label", "for accesskey" & commonAttr)
macro legend*(e: expr): expr =
## generates the HTML ``legend`` element.
result = xmlCheckedTag(e, "legend", "accesskey" & commonAttr)
macro li*(e: expr): expr =
## generates the HTML ``li`` element.
result = xmlCheckedTag(e, "li", commonAttr)
macro link*(e: expr): expr =
## generates the HTML ``link`` element.
result = xmlCheckedTag(e, "link", "href charset hreflang type rel rev media" &
commonAttr, "", true)
macro map*(e: expr): expr =
## generates the HTML ``map`` element.
result = xmlCheckedTag(e, "map", "class title" & eventAttr, "id", false)
macro meta*(e: expr): expr =
## generates the HTML ``meta`` element.
result = xmlCheckedTag(e, "meta", "name http-equiv scheme", "content", true)
macro noscript*(e: expr): expr =
## generates the HTML ``noscript`` element.
result = xmlCheckedTag(e, "noscript", commonAttr)
macro `object`*(e: expr): expr =
## generates the HTML ``object`` element.
result = xmlCheckedTag(e, "object", "classid data codebase declare type " &
"codetype archive standby width height name tabindex" & commonAttr)
macro ol*(e: expr): expr =
## generates the HTML ``ol`` element.
result = xmlCheckedTag(e, "ol", commonAttr)
macro optgroup*(e: expr): expr =
## generates the HTML ``optgroup`` element.
result = xmlCheckedTag(e, "optgroup", "disabled" & commonAttr, "label", false)
macro option*(e: expr): expr =
## generates the HTML ``option`` element.
result = xmlCheckedTag(e, "option", "selected value" & commonAttr)
macro p*(e: expr): expr =
## generates the HTML ``p`` element.
result = xmlCheckedTag(e, "p", commonAttr)
macro param*(e: expr): expr =
## generates the HTML ``param`` element.
result = xmlCheckedTag(e, "param", "value id type valuetype", "name", true)
macro pre*(e: expr): expr =
## generates the HTML ``pre`` element.
result = xmlCheckedTag(e, "pre", commonAttr)
macro q*(e: expr): expr =
## generates the HTML ``q`` element.
result = xmlCheckedTag(e, "q", "cite" & commonAttr)
macro samp*(e: expr): expr =
## generates the HTML ``samp`` element.
result = xmlCheckedTag(e, "samp", commonAttr)
macro script*(e: expr): expr =
## generates the HTML ``script`` element.
result = xmlCheckedTag(e, "script", "src charset defer", "type", false)
macro select*(e: expr): expr =
## generates the HTML ``select`` element.
result = xmlCheckedTag(e, "select", "name size multiple disabled tabindex" &
commonAttr)
macro small*(e: expr): expr =
## generates the HTML ``small`` element.
result = xmlCheckedTag(e, "small", commonAttr)
macro span*(e: expr): expr =
## generates the HTML ``span`` element.
result = xmlCheckedTag(e, "span", commonAttr)
macro strong*(e: expr): expr =
## generates the HTML ``strong`` element.
result = xmlCheckedTag(e, "strong", commonAttr)
macro style*(e: expr): expr =
## generates the HTML ``style`` element.
result = xmlCheckedTag(e, "style", "media title", "type")
macro sub*(e: expr): expr =
## generates the HTML ``sub`` element.
result = xmlCheckedTag(e, "sub", commonAttr)
macro sup*(e: expr): expr =
## generates the HTML ``sup`` element.
result = xmlCheckedTag(e, "sup", commonAttr)
macro table*(e: expr): expr =
## generates the HTML ``table`` element.
result = xmlCheckedTag(e, "table", "summary border cellpadding cellspacing" &
" frame rules width" & commonAttr)
macro tbody*(e: expr): expr =
## generates the HTML ``tbody`` element.
result = xmlCheckedTag(e, "tbody", "align valign" & commonAttr)
macro td*(e: expr): expr =
## generates the HTML ``td`` element.
result = xmlCheckedTag(e, "td", "colspan rowspan abbr axis headers scope" &
" align valign" & commonAttr)
macro textarea*(e: expr): expr =
## generates the HTML ``textarea`` element.
result = xmlCheckedTag(e, "textarea", " name disabled readonly accesskey" &
" tabindex" & commonAttr, "rows cols", false)
macro tfoot*(e: expr): expr =
## generates the HTML ``tfoot`` element.
result = xmlCheckedTag(e, "tfoot", "align valign" & commonAttr)
macro th*(e: expr): expr =
## generates the HTML ``th`` element.
result = xmlCheckedTag(e, "th", "colspan rowspan abbr axis headers scope" &
" align valign" & commonAttr)
macro thead*(e: expr): expr =
## generates the HTML ``thead`` element.
result = xmlCheckedTag(e, "thead", "align valign" & commonAttr)
macro title*(e: expr): expr =
## generates the HTML ``title`` element.
result = xmlCheckedTag(e, "title")
macro tr*(e: expr): expr =
## generates the HTML ``tr`` element.
result = xmlCheckedTag(e, "tr", "align valign" & commonAttr)
macro tt*(e: expr): expr =
## generates the HTML ``tt`` element.
result = xmlCheckedTag(e, "tt", commonAttr)
macro ul*(e: expr): expr =
## generates the HTML ``ul`` element.
result = xmlCheckedTag(e, "ul", commonAttr)
macro `var`*(e: expr): expr =
## generates the HTML ``var`` element.
result = xmlCheckedTag(e, "var", commonAttr)
when isMainModule:
var nim = "Nimrod"
echo h1(a(href="http://force7.de/nimrod", nim))