├── test ├── numbers │ ├── add.pn │ ├── div.pn │ ├── pow.pn │ ├── rem.pn │ ├── shift.pn │ ├── chr.pn │ ├── parens.pn │ ├── precedence.pn │ ├── inc.pn │ ├── integer.pn │ ├── decimal.pn │ ├── vars.pn │ ├── neg.pn │ ├── bytecode.pn │ ├── times.pn │ ├── type.pn │ ├── to.pn │ └── cmp.pn ├── misc │ ├── load.pn │ ├── global.pn │ ├── eval.pn.todo │ ├── buffile.pn │ ├── aio.pn │ ├── assign.pn.todo │ └── database.pn ├── Makefile ├── closures │ ├── inspect.pn │ ├── named1.pn │ ├── nested.pn │ ├── passing.pn │ ├── optional.pn │ ├── arg0.pn │ ├── default.pn │ ├── endings.pn.broken │ ├── long.pn │ ├── named.pn │ └── upvals.pn ├── tables │ ├── reverse.pn │ ├── gettable.pn │ ├── map.pn │ ├── each.pn │ ├── filter.pn │ ├── mixedkeys.pn │ ├── big.pn │ ├── auto.pn │ ├── basic.pn │ └── slice.pn ├── classes │ ├── meta.pn │ ├── def.pn │ ├── monkey.pn │ ├── sub.pn │ └── creature.pn ├── flow │ ├── while.pn │ ├── callcc.pn │ ├── return.pn │ ├── mixed.pn │ ├── if.pn │ ├── break.pn │ ├── continue.pn │ └── except.pn ├── strings │ ├── ord.pn │ ├── join.pn │ ├── utf8.pn │ ├── eval.pn │ ├── quote1.pn │ ├── quote2.pn │ ├── length.pn │ ├── unicode.pn │ ├── slice.pn │ ├── numbers.pn │ └── multiline.pn.broken ├── tutorial │ ├── 01_list.pn │ ├── 03_func.pn │ ├── 02_table.pn │ ├── 04_listfun.pn │ ├── 08_lick.pn │ ├── 05_block.pn │ ├── 06_class.pn │ └── 07_subclass.pn ├── objects │ ├── cast.pn │ ├── inspect.pn │ ├── messages.pn │ ├── call.pn │ ├── vtable.pn │ ├── query.pn │ ├── callset.pn │ └── kind.pn ├── lists │ ├── alloc.pn │ ├── map.pn │ ├── gettuple.pn │ ├── remove.pn │ ├── at.pn │ └── sort.pn ├── logic │ ├── or.pn │ ├── and.pn │ └── not.pn ├── data │ ├── string.pn │ ├── grammar.pn │ └── html.pn ├── testccs.sh ├── api │ ├── CuTest.h │ ├── gc-test.c │ ├── gc-bench.c │ └── CuTest.c └── runtests.sh ├── example ├── sleep.pn ├── fib.pn ├── gcbench-steady.pn ├── 100_doors.pn ├── ackermann.pn ├── fizzbuzz.pn ├── euler001.pn ├── almost_prime.pn ├── prime.pn ├── 100thoddprime.rb ├── 99bottles.pn ├── palindrome.pn ├── recursive.pn ├── 100thoddprime.pn ├── spectral-norm.pn ├── 24_game.pn ├── gcbench-list.pn ├── gcbench.pn ├── binarytrees-list.pn ├── gcbench-table.pn ├── binarytrees.pn ├── fannkuch.pn ├── euler003.pn ├── nqueens.pn └── nbody.pn ├── doc ├── p2-mop.png ├── potion-1.png ├── footer.sh ├── doc.css ├── Doxyfile ├── glossary.textile ├── core-files.txt ├── Doxyfile.chm └── types.md ├── .gitmodules ├── tools ├── dlfcn-win32 │ ├── lib │ │ └── libdl.a │ └── include │ │ └── dlfcn.h ├── version.sh ├── asm.sh ├── mk-release.sh ├── potion-mode.el ├── greg.h └── greg.y ├── .github └── FUNDING.yml ├── lib ├── potion │ ├── debug │ │ ├── z.pn │ │ └── remote.pn │ ├── compile │ │ └── c.pn │ └── debug.pn ├── readline │ ├── Makefile │ ├── readline.c │ └── linenoise.h └── database.c ├── configure ├── appveyor.yml ├── .gitignore ├── .travis.yml ├── core ├── table.h ├── asm.c ├── opcodes.h ├── ast.h ├── lick.c ├── primitive.c ├── asm.h ├── vm-dis.c ├── contrib.c ├── internal.h ├── gc.h ├── callcc.c ├── ast.c ├── mt19937ar.c ├── file.c └── load.c ├── COPYING ├── ChangeLog ├── INSTALL.md └── dist.mak /test/numbers/add.pn: -------------------------------------------------------------------------------- 1 | 2 + 6 #=> 8 2 | -------------------------------------------------------------------------------- /test/numbers/div.pn: -------------------------------------------------------------------------------- 1 | 6 / 2 #=> 3 2 | -------------------------------------------------------------------------------- /test/numbers/pow.pn: -------------------------------------------------------------------------------- 1 | 6 ** 3 #=> 216 2 | -------------------------------------------------------------------------------- /test/numbers/rem.pn: -------------------------------------------------------------------------------- 1 | 216 % 45 #=> 36 2 | -------------------------------------------------------------------------------- /test/numbers/shift.pn: -------------------------------------------------------------------------------- 1 | 90 << 4 #=> 1440 2 | -------------------------------------------------------------------------------- /test/numbers/chr.pn: -------------------------------------------------------------------------------- 1 | 101 chr 2 | 3 | #=> e 4 | -------------------------------------------------------------------------------- /test/misc/load.pn: -------------------------------------------------------------------------------- 1 | load 'test/misc/global' 2 | X #=> X -------------------------------------------------------------------------------- /test/Makefile: -------------------------------------------------------------------------------- 1 | test: 2 | cd ..; test/runtests.sh -q 3 | -------------------------------------------------------------------------------- /test/misc/global.pn: -------------------------------------------------------------------------------- 1 | X = 'X', (X, X kind) #=> (X, String) -------------------------------------------------------------------------------- /test/numbers/parens.pn: -------------------------------------------------------------------------------- 1 | (9 + 1) * (6 - 4) #=> 20 2 | -------------------------------------------------------------------------------- /test/numbers/precedence.pn: -------------------------------------------------------------------------------- 1 | -1 string 2 | 3 | #=> -1 4 | -------------------------------------------------------------------------------- /test/closures/inspect.pn: -------------------------------------------------------------------------------- 1 | (x, y): x + y. 2 | #=> function(x,y) 3 | -------------------------------------------------------------------------------- /test/numbers/inc.pn: -------------------------------------------------------------------------------- 1 | i = 5 2 | (i++, ++i, i) 3 | #=> (5, 7, 7) 4 | -------------------------------------------------------------------------------- /test/tables/reverse.pn: -------------------------------------------------------------------------------- 1 | (1, 2, 3) reverse 2 | 3 | #=> (3, 2, 1) 4 | -------------------------------------------------------------------------------- /example/sleep.pn: -------------------------------------------------------------------------------- 1 | # ffi 2 | sleep_f = extern sleep(int) 3 | sleep_f(5) 4 | -------------------------------------------------------------------------------- /test/classes/meta.pn: -------------------------------------------------------------------------------- 1 | Q = class 2 | Q meta m = : 0x068d. 3 | Q m #=> 1677 -------------------------------------------------------------------------------- /doc/p2-mop.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/perl11/potion/HEAD/doc/p2-mop.png -------------------------------------------------------------------------------- /test/closures/named1.pn: -------------------------------------------------------------------------------- 1 | min = (x, y): y - x. 2 | min(y=12, x=89) #=> -77 3 | -------------------------------------------------------------------------------- /test/flow/while.pn: -------------------------------------------------------------------------------- 1 | x = 0 2 | while (x < 4): 3 | x = x + 1. 4 | x #=> 4 5 | -------------------------------------------------------------------------------- /test/numbers/integer.pn: -------------------------------------------------------------------------------- 1 | float = 1.1 2 | 3 | float integer 4 | 5 | #=> 1 6 | -------------------------------------------------------------------------------- /test/tables/gettable.pn: -------------------------------------------------------------------------------- 1 | p=("xx"=1), k="xx" 2 | (p at(k), p["xx"]) #=> (1, 1) -------------------------------------------------------------------------------- /test/tables/map.pn: -------------------------------------------------------------------------------- 1 | (0=1,1=2,3=4) map(k,v): v+2. sort(true) #=> (3, 4, 6) 2 | -------------------------------------------------------------------------------- /doc/potion-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/perl11/potion/HEAD/doc/potion-1.png -------------------------------------------------------------------------------- /test/numbers/decimal.pn: -------------------------------------------------------------------------------- 1 | (992.0, 444444444444.0) 2 | #=> (992.0, 444444444444.0) 3 | -------------------------------------------------------------------------------- /test/strings/ord.pn: -------------------------------------------------------------------------------- 1 | 'a' ord string print 2 | "a\uABCD" ord(1) 3 | #=> 9743981 4 | -------------------------------------------------------------------------------- /test/tutorial/01_list.pn: -------------------------------------------------------------------------------- 1 | ("cheese", "bread", "mayo") at (1) print 2 | #=> bread 3 | -------------------------------------------------------------------------------- /test/strings/join.pn: -------------------------------------------------------------------------------- 1 | (0.0, 'Potion', 2009) join (" * ") 2 | #=> 0.0 * Potion * 2009 3 | -------------------------------------------------------------------------------- /test/tutorial/03_func.pn: -------------------------------------------------------------------------------- 1 | minus = (x, y): x - y. 2 | minus (y=10, x=6) 3 | #=> -4 4 | -------------------------------------------------------------------------------- /test/strings/utf8.pn: -------------------------------------------------------------------------------- 1 | ("$", "©", "∞", "\u0024", "\u00A9", "\u221e") 2 | #=> ($, ©, ∞, $, ©, ∞) 3 | -------------------------------------------------------------------------------- /test/numbers/vars.pn: -------------------------------------------------------------------------------- 1 | a = 90 << 8 2 | a = a + 3 3 | a = a >> 5 4 | a = a % 13 5 | 6 | (a) #=> (5) 7 | -------------------------------------------------------------------------------- /test/objects/cast.pn: -------------------------------------------------------------------------------- 1 | (true number, false number, nil number, "12" number) 2 | #=> (1, 0, 0, 12) 3 | -------------------------------------------------------------------------------- /.gitmodules: -------------------------------------------------------------------------------- 1 | [submodule "3rd/libuv"] 2 | path = 3rd/libuv 3 | url = https://github.com/rurban/libuv.git 4 | -------------------------------------------------------------------------------- /test/tutorial/02_table.pn: -------------------------------------------------------------------------------- 1 | (language="Potion", pointless=true) at (key="language") print 2 | #=> Potion 3 | -------------------------------------------------------------------------------- /tools/dlfcn-win32/lib/libdl.a: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/perl11/potion/HEAD/tools/dlfcn-win32/lib/libdl.a -------------------------------------------------------------------------------- /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | # These are supported funding model platforms 2 | 3 | github: rurban 4 | patreon: rurban 5 | -------------------------------------------------------------------------------- /test/lists/alloc.pn: -------------------------------------------------------------------------------- 1 | a = list(20) 2 | a put(10, 1) 3 | (a at(0), a at(10), a at(11)) 4 | #=> (nil, 1, nil) 5 | -------------------------------------------------------------------------------- /test/logic/or.pn: -------------------------------------------------------------------------------- 1 | (false or false, false or true, true or false, true or true) #=> (false, true, true, true) 2 | -------------------------------------------------------------------------------- /test/strings/eval.pn: -------------------------------------------------------------------------------- 1 | hello = 2 | "(x): ('hello ', x) print." eval 3 | hello ('world') 4 | #=> hello world 5 | -------------------------------------------------------------------------------- /test/logic/and.pn: -------------------------------------------------------------------------------- 1 | (false and false, false and true, true and false, true and true) #=> (false, false, false, true) 2 | -------------------------------------------------------------------------------- /test/numbers/neg.pn: -------------------------------------------------------------------------------- 1 | (-0, -12, -68, -|-68., ~4, ~16, ~777, ~-168) 2 | #=> (0, -12, -68, 68, -5, -17, -778, 167) 3 | -------------------------------------------------------------------------------- /test/lists/map.pn: -------------------------------------------------------------------------------- 1 | n = (1, 2, 3) 2 | m = n map(n): n + 1. 3 | f = n filter(n): n > 1. 4 | (m, f) #=> ((2, 3, 4), (2, 3)) 5 | -------------------------------------------------------------------------------- /test/misc/eval.pn.todo: -------------------------------------------------------------------------------- 1 | # issue 9 - GC-safe re-entrant parser 2 | 1 to 1000000(): 'x = Object()' eval. 3 | #=> 1000000 4 | -------------------------------------------------------------------------------- /test/objects/inspect.pn: -------------------------------------------------------------------------------- 1 | (40) string print 2 | "elephant" length string print 3 | string print 4 | 5 | #=> (40)8Lobby 6 | -------------------------------------------------------------------------------- /test/tables/each.pn: -------------------------------------------------------------------------------- 1 | ("cheese", "bread", "mayo") each (food): 2 | food length string print. 3 | 0 4 | 5 | #=> 6540 6 | -------------------------------------------------------------------------------- /test/tables/filter.pn: -------------------------------------------------------------------------------- 1 | ("cheese"=0, "bread"=1, "mayo"=2) filter (k,v): v > 0. map(k,v): v. sort(true) 2 | #=> (1, 2) 3 | -------------------------------------------------------------------------------- /test/tutorial/04_listfun.pn: -------------------------------------------------------------------------------- 1 | foods = ("cheese", "bread", "mayo") 2 | (foods (2), foods (index=2)) 3 | #=> (mayo, mayo) 4 | -------------------------------------------------------------------------------- /test/lists/gettuple.pn: -------------------------------------------------------------------------------- 1 | p=(1,2,3), k=1 2 | # for upvals 3 | func = (): p[1]. 4 | (p[k], p[2], p[-1], func()) #=> (2, 3, 3, 2) 5 | -------------------------------------------------------------------------------- /test/tables/mixedkeys.pn: -------------------------------------------------------------------------------- 1 | t = ('name'="potion", (1, 2, 3)=4, "potion" length="?") 2 | (t('name'), t(6)) 3 | #=> (potion, ?) 4 | -------------------------------------------------------------------------------- /test/tutorial/08_lick.pn: -------------------------------------------------------------------------------- 1 | app = [window (width=200, height=400) [para Welcome., button OK]] 2 | app first name 3 | #=> window 4 | -------------------------------------------------------------------------------- /test/objects/messages.pn: -------------------------------------------------------------------------------- 1 | String hidden = (): 2 | (hat = 'trilby', haircut = 'wedge'). 3 | "Guy" hidden ('haircut') #=> wedge 4 | -------------------------------------------------------------------------------- /test/closures/nested.pn: -------------------------------------------------------------------------------- 1 | math = (x): 2 | add = (x, y): x + y. 3 | sub = (x, y): x - y. 4 | sub(add(x, x), x). 5 | math(60) #=> 60 6 | -------------------------------------------------------------------------------- /test/closures/passing.pn: -------------------------------------------------------------------------------- 1 | math = (x): 2 | add = (x, y): x + y. 3 | sub = (x, y): x - y. 4 | sub. 5 | m = math() 6 | m(60, 2) #=> 58 7 | -------------------------------------------------------------------------------- /test/lists/remove.pn: -------------------------------------------------------------------------------- 1 | t = (0,1,2,3) 2 | t1 = t remove(1) 3 | t2 = t delete(2) 4 | 5 | (t, t1, t2) 6 | #=> ((0, 1, 3), (0, 2, 3), (0, 1, 3)) 7 | -------------------------------------------------------------------------------- /test/numbers/bytecode.pn: -------------------------------------------------------------------------------- 1 | (1022, 1023, 1024, 1025, -1022, -1023, -1024, -1025) 2 | #=> (1022, 1023, 1024, 1025, -1022, -1023, -1024, -1025) 3 | -------------------------------------------------------------------------------- /test/numbers/times.pn: -------------------------------------------------------------------------------- 1 | 5 times: "Odelay" print. 2 | 3 | 10 times (i): i string print. 4 | 5 | #=> OdelayOdelayOdelayOdelayOdelay012345678910 6 | -------------------------------------------------------------------------------- /test/tables/big.pn: -------------------------------------------------------------------------------- 1 | i = 0 2 | tbl = (x=6) 3 | while (i < 4000): 4 | tbl put(i, i++). 5 | 6 | (tbl at(3999), tbl at('x')) 7 | #=> (3999, 6) 8 | -------------------------------------------------------------------------------- /lib/potion/debug/z.pn: -------------------------------------------------------------------------------- 1 | # socket to ZeroBrane Studio 2 | # TODO: lua mobdebug protocol, serpent serializer 3 | 4 | load "debug/remote" 5 | # debug 6 | -------------------------------------------------------------------------------- /test/strings/quote1.pn: -------------------------------------------------------------------------------- 1 | ('it''s garbage day', 'the internal\revenue\service is here') 2 | #=> (it's garbage day, the internal\revenue\service is here) 3 | -------------------------------------------------------------------------------- /test/closures/optional.pn: -------------------------------------------------------------------------------- 1 | sub = (x=N|y=N): x+y. 2 | (sub(1), sub(0,1), sub(x=0), sub, sub arity, sub minargs) 3 | #=> (1, 1, 0, function(x=N|y=N), 2, 1) 4 | -------------------------------------------------------------------------------- /test/closures/arg0.pn: -------------------------------------------------------------------------------- 1 | msg = (): "no arguments" print. 2 | msg () 3 | 4 | msg2 =: " and highly sparse". 5 | msg2 () 6 | 7 | #=> no arguments and highly sparse 8 | -------------------------------------------------------------------------------- /test/objects/call.pn: -------------------------------------------------------------------------------- 1 | a = 52 2 | b = "the" 3 | c = nil 4 | d = (6, 7, 8, 9) 5 | e = true 6 | 7 | (a(1), b(1), c(1), d(1), e(1)) 8 | #=> (52, h, nil, 7, true) 9 | -------------------------------------------------------------------------------- /test/strings/quote2.pn: -------------------------------------------------------------------------------- 1 | ("ahh, the \"new\" potion", 2 | "tofu\nlime\ncoconut milk") 3 | 4 | #=> (ahh, the "new" potion, tofu 5 | #=> lime 6 | #=> coconut milk) 7 | -------------------------------------------------------------------------------- /test/closures/default.pn: -------------------------------------------------------------------------------- 1 | sub = (x:=0, y:=1): y - x. 2 | (sub(), sub(1), sub(0,1), sub(y=0), sub, sub arity, sub minargs) 3 | #=> (1, 0, 1, 1, function(x:=0,y:=1), 2, 0) 4 | -------------------------------------------------------------------------------- /test/tables/auto.pn: -------------------------------------------------------------------------------- 1 | a = (1, 2, 3, x=4) 2 | 3 | b = (1, 2, 3) 4 | b put(1000000, 'HUGE') 5 | 6 | (a at(1), a at('x'), b at(2), b at(1000000)) 7 | #=> (2, 4, 3, HUGE) 8 | -------------------------------------------------------------------------------- /example/fib.pn: -------------------------------------------------------------------------------- 1 | fib = (n): 2 | if (n < 2): n. 3 | else: fib (n - 1) + fib (n - 2). 4 | . 5 | n = argv(1) number 6 | if (n<1): n=28. 7 | ("fib(",n,")= ", fib(n)) join say 8 | -------------------------------------------------------------------------------- /test/classes/def.pn: -------------------------------------------------------------------------------- 1 | Triplet = class (a, b, c): /first = a, /second = b, /third = c. 2 | Triplet sum = (): /first + /second + /third. 3 | Triplet (71, 42, 90) sum 4 | #=> 203 5 | -------------------------------------------------------------------------------- /test/misc/buffile.pn: -------------------------------------------------------------------------------- 1 | load "buffile" 2 | #f = tmpfile 3 | f = fopen("tmpfile.tmp", "w") 4 | buf = "xxx" 5 | x = f write(buf,nil,1) 6 | y = f unlink 7 | (x, y) #=> (1, true) 8 | -------------------------------------------------------------------------------- /test/strings/length.pn: -------------------------------------------------------------------------------- 1 | a = "\u0024\u00A9\u221E" 2 | b = "hello, world\n" 3 | c = "naïve" 4 | d = "こんにちは" 5 | (a length, b length, c length, d length) 6 | #=> (3, 13, 5, 5) 7 | -------------------------------------------------------------------------------- /test/tutorial/05_block.pn: -------------------------------------------------------------------------------- 1 | (dog="canine", cat="feline", fox="vulpine") each (key, val): 2 | if (key == "dog"): (key, " is a ", val) join print. 3 | . 4 | '' 5 | #=> dog is a canine 6 | -------------------------------------------------------------------------------- /test/tutorial/06_class.pn: -------------------------------------------------------------------------------- 1 | Person = class: /name, /age, /sex. 2 | Person print = (): 3 | ("My name is ", /name, ".") join print. 4 | p = Person () 5 | p print 6 | #=> My name is nil. 7 | -------------------------------------------------------------------------------- /test/logic/not.pn: -------------------------------------------------------------------------------- 1 | (not true, not false, not 2, not "kxxx!", not not true, !!true, !!false, !false, not nil, !!nil) 2 | #=> (false, true, false, false, true, true, false, true, true, false) 3 | -------------------------------------------------------------------------------- /test/strings/unicode.pn: -------------------------------------------------------------------------------- 1 | # https://github.com/fogus/potion/issues/33 2 | "snowman - \u2603 " print 3 | "attic 50 - \U{10144}" print 4 | "\U{10144}" ord 5 | #=> snowman - ☃ attic 50 - 𐅄65860 6 | -------------------------------------------------------------------------------- /test/closures/endings.pn.broken: -------------------------------------------------------------------------------- 1 | func = (x, y): 2 | x ** y 3 | … func 4 | 5 | func2 = (x, y): 6 | x % y 7 | _ func2 8 | 9 | (func, func2) 10 | # (function(x, y), function(x, y)) 11 | -------------------------------------------------------------------------------- /test/classes/monkey.pn: -------------------------------------------------------------------------------- 1 | ary = (9, 14, 56) 2 | 3 | ary kind extra = 80 4 | 5 | ary kind sum = (): 6 | i = 0 7 | each (x): i = i + x. 8 | i. 9 | 10 | ary sum + ary extra 11 | #=> 159 12 | -------------------------------------------------------------------------------- /test/lists/at.pn: -------------------------------------------------------------------------------- 1 | list = ("badgers", "bottles", "germans") 2 | list2 = ('does', 'exists') 3 | (list at(2), list at(4), list at(-2), list2(1), list(-2)) 4 | #=> (germans, nil, bottles, exists, bottles) 5 | -------------------------------------------------------------------------------- /test/objects/vtable.pn: -------------------------------------------------------------------------------- 1 | 1 kind def ("test", (x): self + 2.) 2 | 3 | String def ("length2", (): length.) 4 | 5 | Number def ("zero", 0) 6 | 7 | (1 test, "Potion" length2, 4 zero) 8 | #=> (3, 6, 0) 9 | -------------------------------------------------------------------------------- /example/gcbench-steady.pn: -------------------------------------------------------------------------------- 1 | # 2 | # allocate a million lists, but dispose of them immediately. 3 | # run with -V option to see memory use. 4 | # 5 | ary = nil 6 | 1000000 times: ary = list(200000). 7 | nil 8 | -------------------------------------------------------------------------------- /test/classes/sub.pn: -------------------------------------------------------------------------------- 1 | BTree = class (r, l): /left = l, /right = r. 2 | b = BTree (52, 7) 3 | 4 | CTree = BTree class 5 | c = CTree (81, 9) 6 | 7 | (b /left, b /right, c /left, c /right) 8 | #=> (7, 52, 9, 81) 9 | -------------------------------------------------------------------------------- /test/closures/long.pn: -------------------------------------------------------------------------------- 1 | sum = (a, b, c, d, e, f, g, h, i, j, k, l, m, n): 2 | a + b + c + d + e + f + g + h + i + j + k + l + m + n. 3 | 4 | sum (1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14) 5 | #=> 105 6 | -------------------------------------------------------------------------------- /test/numbers/type.pn: -------------------------------------------------------------------------------- 1 | (1, 1.0) each (x): x integer? string print. 2 | (1, 1.0) each (x): x double? string print. 3 | (1, 1.0) each (x): x number? string print. 4 | 5 | #=> truefalsefalsetruetruetrue(1, 1.0) 6 | -------------------------------------------------------------------------------- /test/data/string.pn: -------------------------------------------------------------------------------- 1 | ([potion 0.0 (date='2009-06-16')], 2 | [app [stack [button Mice, button Eagles, button Quail]]]) 3 | #=> ([potion 0.0 (date=2009-06-16)], [app [stack [button Mice, button Eagles, button Quail]]]) 4 | -------------------------------------------------------------------------------- /test/numbers/to.pn: -------------------------------------------------------------------------------- 1 | 1 to 5 (x): x string print. 2 | 5 to 1 (x): x string print. 3 | 4 | one = 1, five = 5 5 | five to (one, (x): x string print.) 6 | one to (five, (x): x string print.) 7 | #=> 123455432154321123455 8 | -------------------------------------------------------------------------------- /test/flow/callcc.pn: -------------------------------------------------------------------------------- 1 | names = ("Freddie", "Herbie", "Ron", "Max", "Ringo") 2 | goto = here 3 | name = names pop 4 | (name, "\n") join print 5 | if (name != "Ron"): goto (). 6 | #=> Ringo 7 | #=> Max 8 | #=> Ron 9 | 10 | -------------------------------------------------------------------------------- /example/100_doors.pn: -------------------------------------------------------------------------------- 1 | # See http://rosettacode.org/wiki/100_doors#Potion 2 | 3 | square=1, i=3 4 | 1 to 100(door): 5 | if (door == square): 6 | ("door", door, "is open") say 7 | square += i 8 | i += 2. 9 | . 10 | -------------------------------------------------------------------------------- /test/closures/named.pn: -------------------------------------------------------------------------------- 1 | sub = (x, y): y - x. 2 | 3 | b = (99, 98, 97) 4 | b put(index=1, value="XXX") 5 | 6 | (1, sub(y=12, x=89), b at(index=2), b at(index=1), "Kirikuro" slice(start=0, end=-2)) 7 | #=> (1, -77, 97, XXX, Kiriku) 8 | -------------------------------------------------------------------------------- /test/objects/query.pn: -------------------------------------------------------------------------------- 1 | a = (1, 1, 2, 3, 5, 8) 2 | b = "Orville Redenbacher's Son" 3 | (a ?length, a ?length (), b ?slice, b ?slice (2, 5), 4 | a ?nothing, a ?nothing ("newp"), b ?longth, b ?langth (6, 8)) 5 | #=> (true, 6, true, vil, false, nil, false, nil) 6 | -------------------------------------------------------------------------------- /test/lists/sort.pn: -------------------------------------------------------------------------------- 1 | t=() 2 | 1 to 6(i):t push (i). 3 | t1 = t ins_sort(false) 4 | 5 | t=() 6 | 1 to 10(i):t push (i). 7 | t2 = t sort(false) 8 | 9 | (t, t1, t2) 10 | #=> ((1, 2, 3, 4, 5, 6, 7, 8, 9, 10), (6, 5, 4, 3, 2, 1), (10, 9, 8, 7, 6, 5, 4, 3, 2, 1)) 11 | -------------------------------------------------------------------------------- /test/strings/slice.pn: -------------------------------------------------------------------------------- 1 | ( 2 | "abcdef" slice(1, 5) 3 | "abc" slice(0, 3) 4 | "abc" slice(nil, 3) 5 | "abc" slice(nil, nil) 6 | "abcd" slice(-3, -1) 7 | "abcde" slice(3,2) 8 | "乔纳森莱特" slice(0, 3) 9 | ) 10 | #=> (bcde, abc, abc, abc, bc, de, 乔纳森) 11 | -------------------------------------------------------------------------------- /example/ackermann.pn: -------------------------------------------------------------------------------- 1 | ack = (m, n): 2 | if (m == 0): n + 1 3 | . elsif (n == 0): ack(m - 1, 1) 4 | . else: ack(m - 1, ack(m, n - 1)). 5 | . 6 | 7 | #ack(3,4) say 8 | 9 | 4 times(m): 10 | 7 times(n): 11 | ack(m, n) print 12 | " " print. 13 | "\n" print. -------------------------------------------------------------------------------- /test/tutorial/07_subclass.pn: -------------------------------------------------------------------------------- 1 | Person = class: /name, /age, /sex. 2 | Policeman = Person class (rank): /rank = rank. 3 | Policeman print = (): 4 | ("My name is ", /name, " and I'm a ", /rank, ".") join print. 5 | 6 | Policeman ("Constable") print 7 | #=> My name is nil and I'm a Constable. 8 | -------------------------------------------------------------------------------- /example/fizzbuzz.pn: -------------------------------------------------------------------------------- 1 | # http://rosettacode.org/wiki/FizzBuzz#Potion 2 | # written by havenwood 3 | 4 | 1 to 100 (a): 5 | if (a % 15 == 0): 6 | 'FizzBuzz'. 7 | elsif (a % 3 == 0): 8 | 'Fizz'. 9 | elsif (a % 5 == 0): 10 | 'Buzz'. 11 | else: a. string print 12 | "\n" print. 13 | -------------------------------------------------------------------------------- /test/objects/callset.pn: -------------------------------------------------------------------------------- 1 | a = 52 2 | a (1) = 4 3 | b = "the" 4 | b (1) = "o" 5 | c = nil 6 | c (1) = "o" 7 | d = (6, 7, 8, 9) 8 | d (1) = 0 9 | e = true 10 | e (1) = "o" 11 | f = (a=1, b=2, c=3) 12 | f ("b") = 3 13 | 14 | (a, b, c, d, e, f ("b")) 15 | #=> (52, the, nil, (6, 0, 8, 9), true, 3) 16 | -------------------------------------------------------------------------------- /test/strings/numbers.pn: -------------------------------------------------------------------------------- 1 | ("" number, 2 | "0" number, 3 | "1" number, 4 | "-1" number, 5 | "12" number, 6 | "722222227" number, 7 | "-722222227" number, 8 | "3.141591" number, 9 | "900000000000009" number) 10 | 11 | #=> (0, 0, 1, -1, 12, 722222227, -722222227, 3.141591, 900000000000009.0) 12 | -------------------------------------------------------------------------------- /test/flow/return.pn: -------------------------------------------------------------------------------- 1 | one = (): 2 | return(1). 3 | 4 | two = (): 5 | return(2) 6 | -1. 7 | 8 | three = (): 9 | -1 10 | return(3) 11 | -2. 12 | 13 | nil1 = (): 14 | return. 15 | 16 | nil2 = (): 17 | return(nil). 18 | 19 | (one(), two(), three(), nil1(), nil2()) 20 | #=> (1, 2, 3, nil, nil) 21 | -------------------------------------------------------------------------------- /test/flow/mixed.pn: -------------------------------------------------------------------------------- 1 | name = "Pieter" 2 | if (name length < 4): 3 | "WRONG" 4 | . elsif (name length < 1): 5 | "ALSO WRONG" 6 | . else: 7 | while (name length > 4): 8 | if (name length == 6): name = "Georg". 9 | elsif (name length == 5): name = "Seth". 10 | else: name = "Oz". 11 | . 12 | name. 13 | 14 | #=> Seth 15 | -------------------------------------------------------------------------------- /test/misc/aio.pn: -------------------------------------------------------------------------------- 1 | # requires a TCP daemon on localhost port 80 2 | load "aio" 3 | tcp = Aio_tcp 4 | connected = 0 5 | connect_cb = (req,status): 6 | connected++ 7 | "connected" print. 8 | tcp connect(Aio_connect, "127.0.0.1", 80, connect_cb) 9 | tcp run 10 | if (connected == 0): "not connected" print. 11 | "" 12 | #=> connected 13 | -------------------------------------------------------------------------------- /test/flow/if.pn: -------------------------------------------------------------------------------- 1 | a = if (false): 12 2 | . elsif (true): 14 3 | . else: 16. 4 | 5 | b = if (false): 12 6 | . elsif (nil): 14 7 | . else: 16. 8 | 9 | c = if (true): 12 10 | . elsif (true): 14 11 | . else: 16. 12 | 13 | d = 40 if true: self. else: 10. 14 | 15 | e = 40 if true: 10. 16 | 17 | (a, b, c, d, e) #=> (14, 16, 12, Lobby, 10) 18 | -------------------------------------------------------------------------------- /example/euler001.pn: -------------------------------------------------------------------------------- 1 | # If we list all the natural numbers below 10 that are multiples of 3 or 5, 2 | # we get 3, 5, 6 and 9. The sum of these multiples is 23. 3 | # Find the sum of all the multiples of 3 or 5 below 1000. 4 | # L 5 | 6 | sum=0 7 | 3 to 999 (i): 8 | if ((i%3 == 0) or (i%5 == 0)): sum += i. 9 | . 10 | sum say 11 | -------------------------------------------------------------------------------- /test/misc/assign.pn.todo: -------------------------------------------------------------------------------- 1 | (1, x) = (1, 2) #=> (x=2) 2 | (1, x) = (2, 3) #=> false 3 | 1 = 2 #=> false 4 | 5 | (_, x, 2) = (0, 1, 2) and say x #=> 1 6 | [_, [x, 1]] = [0, [1, 2]] and say x #=> 1 7 | [_, x] = [0, [1, 2]] and say x #=> [1, 2] 8 | [_ | x] = [0, 1, 2] and say x #=> [1, 2] 9 | 10 | fun = (a, b): [0, [a, b]]. 11 | [_ | [x, 1]] = fun(1, 2) and say x #=> 1 12 | -------------------------------------------------------------------------------- /test/tables/basic.pn: -------------------------------------------------------------------------------- 1 | p = (date='2009-01-12', commit='0cd914e', platform='i686-apple-darwin8', jit=1) 2 | a = p at('platform') 3 | 4 | p put('platform', 'i386-undermydesk-freebsd') 5 | b = p at('platform') 6 | 7 | p remove('date') 8 | 9 | (a, b, p length, (i_exist=1) at ('nonexistant'), p('commit'), p('date')) 10 | #=> (i686-apple-darwin8, i386-undermydesk-freebsd, 3, nil, 0cd914e, nil) 11 | -------------------------------------------------------------------------------- /test/flow/break.pn: -------------------------------------------------------------------------------- 1 | single = (): 2 | i = 0 3 | while (i < 30): 4 | i++ 5 | if (i >= 10): break.. 6 | i. 7 | 8 | first = (): 9 | i = 0 10 | while (i < 30): 11 | i++ 12 | if (i >= 10): break. 13 | if (i >= 20): break.. 14 | i. 15 | 16 | second = (): 17 | i = 0 18 | while (i < 30): 19 | i++ 20 | if (i >= 20): break. 21 | if (i >= 10): break.. 22 | i. 23 | 24 | (single(), first(), second()) 25 | #=> (10, 10, 10) 26 | -------------------------------------------------------------------------------- /configure: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | test -f config.inc && mv config.inc config.inc.bak 3 | test -f core/config.h && mv core/config.h core/config.h.bak 4 | if make --version 2>/dev/null | grep GNU 5 | then 6 | make -f config.mak $@ 7 | else 8 | sed -e's, ?= , = ,;s,-lm -ldl,-lm,;s,config.mak,config.mk,g;s,makefile-gmake,makefile-bsdmake,;' config.mak > config.mk 9 | sed -e's, ?= , = ,;s,config.mak,config.mk,g;' Makefile > BSDmakefile 10 | make -f config.mk $@ 11 | fi 12 | -------------------------------------------------------------------------------- /test/data/grammar.pn: -------------------------------------------------------------------------------- 1 | math = [grammar [ 2 | digit <- n:[0-9] { n number } 3 | value <- d:digit+ | '(' e:expr ')' { d or e } 4 | expr <- l:value op:[*/] r:value 5 | { 6 | if (op == '*'): l * r. else: l / r. 7 | } 8 | main<- expr 9 | ]] 10 | #=> [grammar [digit <- n:[0-9] { n number }, value <- d:digit+ | '(' e:expr ')' { d or e }, expr <- l:value op:[*/] r:value 11 | #=> { 12 | #=> if (op == '*'): l * r. else: l / r. 13 | #=> }, main <- expr]] 14 | -------------------------------------------------------------------------------- /lib/readline/Makefile: -------------------------------------------------------------------------------- 1 | include ../../config.inc 2 | SRC = linenoise.c 3 | ifeq ($(WIN32),1) 4 | SRC += win32fixes.c 5 | LIBS += -lws2_32 6 | endif 7 | 8 | all: readline${LOADEXT} 9 | 10 | static: readline.o linenoise.o 11 | 12 | %.o: %.c 13 | @$(CC) -c $(CFLAGS) -o $@ $(INCS) $< 14 | 15 | %${LOADEXT}: %.c 16 | @$(CC) $(CFLAGS) -o $@ $(INCS) $(LDDLLFLAGS) $(SRC) $< ${LIBPTH} -lpotion $(LIBS) 17 | 18 | test: 19 | 20 | clean: 21 | @rm -f readline${LOADEXT} *.o 22 | -------------------------------------------------------------------------------- /test/tables/slice.pn: -------------------------------------------------------------------------------- 1 | t = (0,1,2) 2 | t slice(0,nil) say #=> (0, 1, 2) 3 | t slice(1,nil) say #=> (1, 2) 4 | t slice(0,1) say #=> (0, 1) 5 | t slice(-1,nil) say #=> (2) 6 | t slice(1,1) say #=> (1) 7 | t slice(1,-1) say #=> (1, 2) 8 | t slice(2,-1) say #=> (2) 9 | t slice(-1,-2) say #=> (1, 2) 10 | 11 | t = (0="a", 1="b", 2="c") 12 | t slice say #=> (0=a, 2=c, 1=b) 13 | t slice((1,2,3)) keys sort(true) say #=> (1, 2) 14 | t slice(()) say #=> () 15 | -------------------------------------------------------------------------------- /example/almost_prime.pn: -------------------------------------------------------------------------------- 1 | # See http://rosettacode.org/wiki/Almost_prime#Potion 2 | kprime = (n, k): 3 | p = 2, f = 0 4 | while (f < k && p*p <= n): 5 | while (0 == n % p): 6 | n /= p 7 | f++. 8 | p++. 9 | n = if (n > 1): 1. 10 | else: 0. 11 | f + n == k. 12 | 13 | 1 to 5 (k): 14 | "k = " print, k print, ":" print 15 | i = 2, c = 0 16 | while (c < 10): 17 | if (kprime(i, k)): " " print, i print, c++. 18 | i++ 19 | . 20 | "" say. 21 | -------------------------------------------------------------------------------- /test/closures/upvals.pn: -------------------------------------------------------------------------------- 1 | cl = (): cl. 2 | 3 | n = 4 4 | m = 11 5 | cl2 = (): m + n. 6 | n = 6 7 | 8 | o = 19 9 | cl3 = (): 10 | cl4 = (): o = 23. 11 | cl4 () 12 | p = 45. 13 | 14 | x = 55 15 | cl4 = (y): x + y. 16 | 17 | z1 = true 18 | z2 = 16 19 | z3 = list(2) 20 | z4 = (a=1) 21 | "" print 22 | 23 | z = (): 24 | z4 = (b=2) 25 | z4. 26 | 27 | (cl (), cl2 (), cl3 (), cl4 (12), o, z1, z2, z3, z()) 28 | #=> (function(), 17, 45, 67, 23, true, 16, (nil, nil), (b=2)) 29 | -------------------------------------------------------------------------------- /test/classes/creature.pn: -------------------------------------------------------------------------------- 1 | Creature = class (l, s, c, w): 2 | /life = l 3 | /strength = s 4 | /charisma = c 5 | /weapon = w. 6 | 7 | Creature traits =: 8 | (/life, /strength, /charisma, /weapon). 9 | 10 | Rabbit = Creature class (b): 11 | /life = 10 12 | /strength = 44 13 | /charisma = 44 14 | /weapon = 4 15 | /bombs = b. 16 | 17 | c = Creature(45, 65, 27, 89) 18 | r = Rabbit(3) 19 | (c traits, r traits, r /bombs) 20 | 21 | #=> ((45, 65, 27, 89), (10, 44, 44, 4), 3) 22 | -------------------------------------------------------------------------------- /example/prime.pn: -------------------------------------------------------------------------------- 1 | # See e.g. http://digitalbush.com/2010/02/26/sieve-of-eratosthenes-in-csharp/ 2 | 3 | primes = (n): 4 | notprime = array(n), result = (2), max = n sqrt integer 5 | i = 3 6 | while (i < n): 7 | if (notprime(i)): i++, i++, continue. 8 | if (i <= max): 9 | m = i * i 10 | while (m < n): 11 | notprime(m) = true 12 | m += i 13 | m += i 14 | . 15 | . 16 | result push(i) 17 | i++, i++ 18 | . 19 | result 20 | . 21 | 22 | primes(20) say 23 | -------------------------------------------------------------------------------- /test/data/html.pn: -------------------------------------------------------------------------------- 1 | build = (node): 2 | "<" print, node name print 3 | if (node attr): 4 | node attr string print. 5 | ">" print 6 | if (node licks): 7 | i = 0, l = node licks 8 | while (i < l length): 9 | build(l(i)) 10 | i++. 11 | . elsif (node text): 12 | node text print. 13 | "" print. 14 | 15 | build [html [body (margin=0) [p "SUPERIOR!", em, strong (padding=2)]]] 16 | #=>

SUPERIOR!

17 | -------------------------------------------------------------------------------- /example/100thoddprime.rb: -------------------------------------------------------------------------------- 1 | # written by Kokizzu 2 | # https://stackoverflow.com/questions/29091475/printing-odd-prime-every-100k-primes-found/ 3 | # see also the slower potion variant. 4 | 5 | res = [last=3] 6 | loop do 7 | last += 2 8 | prime = true 9 | res.each do |v| 10 | break if v*v > last 11 | if last % v == 0 12 | prime = false 13 | break 14 | end 15 | end 16 | if prime 17 | res << last 18 | puts last if res.length % 100000 == 0 19 | break if last > 9999999 20 | end 21 | end 22 | -------------------------------------------------------------------------------- /lib/potion/debug/remote.pn: -------------------------------------------------------------------------------- 1 | # via tcp socket 2 | # TODO: sock callbacks 3 | 4 | load "debug" 5 | 6 | # TODO: parse comma delim args 7 | remote.debug = Debug class (args): 8 | /init = (): load "aio". 9 | 10 | /init() 11 | /port = 8172 12 | /sock = Aio_tcp 13 | /read = (): self/sock read. 14 | /write = (o): self/sock write(o). 15 | 16 | /sock bind("127.0.0.1", self/port) 17 | /sock listen(1, self connect_cb) 18 | /sock run 19 | . 20 | 21 | remote.debug connect_cb = (req, st): . 22 | remote.debug read_cb = (req, st): . 23 | 24 | debug = remote.debug 25 | -------------------------------------------------------------------------------- /example/99bottles.pn: -------------------------------------------------------------------------------- 1 | count = 99 2 | 99 times: 3 | "" say 4 | if (count == 1): 5 | (count, " bottle of beer on the wall") join say 6 | (count, " bottle of beer") join say. 7 | else: 8 | (count, " bottles of beer on the wall") join say 9 | (count, " bottles of beer") join say. 10 | 11 | "Take one down, pass it around" say 12 | count = count - 1 13 | if (count == 1): 14 | (count, " bottle of beer on the wall") join say. 15 | else: 16 | (count, " bottles of beer on the wall") join say. 17 | "" say. 18 | "No more bottles of beer on the wall" say 19 | -------------------------------------------------------------------------------- /lib/readline/readline.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include "linenoise.h" 5 | 6 | PN pn_readline(Potion *P, PN cl, PN self, PN start) { 7 | char *line = linenoise(PN_STR_PTR(start)); 8 | PN r; 9 | if (line == NULL) return PN_NIL; 10 | 11 | linenoiseHistoryLoad("history.txt"); 12 | linenoiseHistoryAdd(line); 13 | linenoiseHistorySave("history.txt"); 14 | r = potion_str(P, line); 15 | free(line); 16 | return r; 17 | } 18 | 19 | void Potion_Init_readline(Potion *P) { 20 | potion_method(P->lobby, "readline", pn_readline, "start=S"); 21 | } 22 | -------------------------------------------------------------------------------- /test/objects/kind.pn: -------------------------------------------------------------------------------- 1 | "1" isa?(String) say #=> true 2 | 1.0 isa?(Number) say #=> true 3 | 1.0 subclass?(Number) say #=> true 4 | 5 | #1.0 isa?(Double) say # => true 6 | #d:Double = 1.0 7 | #d isa?(Double) say # => true 8 | #i:Integer = 1 9 | #i isa?(Integer) say # => true 10 | #i subclass?(Number) say # => true 11 | 12 | (10 kind == Number, # still not an Integer, only after type inference 13 | nil kind == NilKind, 14 | "mailbox" kind == String, 15 | 10 kind == Boolean, 16 | nil kind == Boolean, 17 | "mailbox" kind == Boolean) 18 | #=> (true, true, true, false, false, false) 19 | -------------------------------------------------------------------------------- /doc/footer.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | GENERATED=`date +"%a %b %d %Y"` 3 | POTION_VERSION=`perl -ane'/POTION_VERSION/ && print $F[2]' core/potion.h` 4 | POTION_DATE=`perl -ane'/POTION_DATE/ && print $F[2]' core/config.h` 5 | POTION_REV=`perl -ane'/POTION_REV/ && print $F[2]' core/config.h` 6 | DOXYGEN_VERSION=`doxygen --version` 7 | 8 | echo '
' 9 | echo "Generated on $GENERATED for potion $POTION_VERSION.$POTION_REV (date=$POTION_DATE)" 10 | echo ') by doxygen ' $DOXYGEN_VERSION 11 | echo '
' 12 | -------------------------------------------------------------------------------- /test/flow/continue.pn: -------------------------------------------------------------------------------- 1 | single = (): 2 | i = 0 3 | c = 0 4 | while (i < 30): 5 | i++ 6 | continue 7 | c++. 8 | c. 9 | 10 | first = (): 11 | i = 0 12 | c = 0 13 | d = 0 14 | while (i < 30): 15 | i++ 16 | if (i <= 10): continue. 17 | c++ 18 | if (i <= 20): continue. 19 | d++. 20 | (c, d). 21 | 22 | second = (): 23 | i = 0 24 | c = 0 25 | d = 0 26 | while (i < 30): 27 | i++ 28 | if (i <= 20): continue. 29 | c++ 30 | if (i <= 10): continue. 31 | d++. 32 | (c, d). 33 | 34 | (single(), first(), second()) 35 | #=> (0, (20, 10), (10, 10)) 36 | -------------------------------------------------------------------------------- /example/palindrome.pn: -------------------------------------------------------------------------------- 1 | # See http://rosettacode.org/wiki/Palindrome_detection#Potion 2 | # The readable recursive version: 3 | # A single char is surely a palindrome; a string is a palindrome if 4 | # first and last char are the same and the remaining string (the 5 | # string starting from the second char and ending to the char 6 | # preceding the last one) is itself a palindrome. 7 | 8 | palindrome_i = (s, b, e): 9 | if (e <= b): true. 10 | elsif (s ord(b) != s ord(e)): false. 11 | else: palindrome_i(s, b+1, e-1). 12 | . 13 | 14 | palindrome = (s): 15 | palindrome_i(s, 0, s length - 1). 16 | 17 | palindrome(argv(1)) -------------------------------------------------------------------------------- /lib/potion/compile/c.pn: -------------------------------------------------------------------------------- 1 | # TODO write this c compiler 2 | Source = class(source|opts=S): /source = source, /opts = opts. 3 | 4 | # optionally transform ast 5 | # no methods for the various ast types, as we have no ast types yet :) 6 | # TODO: support method combinations? before, after, around 7 | #SourceBlock compile :after = (): . 8 | 9 | # the walker 10 | #Source compile :after = (): 11 | # "compilec" /opts join say 12 | # /source. 13 | 14 | # the emitter 15 | # dump c code for compiled ast 16 | Source dumpc = (source|opts=S): 17 | /source = source 18 | /opts = opts 19 | "dumpc" opts join say 20 | source string. 21 | 22 | 1 23 | -------------------------------------------------------------------------------- /appveyor.yml: -------------------------------------------------------------------------------- 1 | version: 0.3.{build} 2 | skip_tags: true 3 | os: MinGW 4 | platform: 5 | - x86 6 | - x64 7 | clone_depth: 1 8 | init: 9 | - git config --global core.autocrlf input 10 | install: 11 | - mingw-get install mingw-developer-toolkit 12 | - cinst make 13 | - git submodule init --update 14 | build_script: 15 | - mkdir bin 16 | - make -f config.mak 17 | - make 18 | test_script: 19 | - make test 20 | notifications: 21 | - provider: Email 22 | to: 23 | - rurban@x-ray.at 24 | subject: potion windows build 25 | on_build_success: true 26 | on_build_failure: true 27 | on_build_status_changed: false -------------------------------------------------------------------------------- /example/recursive.pn: -------------------------------------------------------------------------------- 1 | n = 11 2 | 3 | ack = (m, n): 4 | if (m == 0): n + 1 5 | . elsif (n == 0): ack(m - 1, 1) 6 | . else: ack(m - 1, ack(m, n - 1)). 7 | . 8 | 9 | fib = (n): 10 | if (n <= 1): 1. else: fib (n - 1) + fib (n - 2). 11 | . 12 | 13 | tak = (x, y, z): 14 | if (y >= x): z 15 | . else: tak(tak(x - 1, y, z), tak(y - 1, z, x), tak(z - 1, x, y)). 16 | . 17 | 18 | n-- 19 | ("Ack(3,", n + 1, "): ", ack(3, n + 1), "\n") join print 20 | ("Fib(", n + 28, "): ", fib(n + 28), "\n") join print 21 | ("Tak(", (3 * n, 2 * n, n) join (","), "): ", tak(3 * n, 2 * n, n), "\n") join print 22 | ("Fib(3): ", fib(3), "\n") join print 23 | ("Tak(3,2,1): ", tak(3, 2, 1), "\n") join print 24 | -------------------------------------------------------------------------------- /example/100thoddprime.pn: -------------------------------------------------------------------------------- 1 | # very slow potion aref method call, compared to ruby. 2 | # 6m30s in the jit, compared to 30s with ruby 3 | # written by Kokizzu 4 | # https://stackoverflow.com/questions/29091475/printing-odd-prime-every-100k-primes-found/ 5 | last = 3 6 | res = (last) # create array 7 | loop: 8 | last += 2 9 | prime = true 10 | len = res length 11 | i = 0 12 | while(i last): break. 17 | if(last%v == 0): prime = false, break. 18 | i += 1 19 | . 20 | if(prime): 21 | res append(last) 22 | if(res length % 100000 == 0): last say. 23 | if(last>9999999): break. 24 | . 25 | . 26 | -------------------------------------------------------------------------------- /test/strings/multiline.pn.broken: -------------------------------------------------------------------------------- 1 | (%% Clearly, you and I should be up there. 2 | We should be the hosts of this banquet. 3 | I'd press the elevator button for people 4 | And clean the crab legs and you'd help me. 5 | 6 | %% I'll bet the staff just lives upstairs, 7 | Heck, all we'd need is a bunk bed. 8 | I could pick out what the waitresses wear and, 9 | After that, I'd come find you and take a break. 10 | 11 | ) 12 | 13 | # (Clearly, you and I should be up there. 14 | # We should be the hosts of this banquet. 15 | # I'd press the elevator button for people 16 | # And clean the crab legs and you'd help me., I'll bet the staff just lives upstairs, 17 | # Heck, all we'd need is a bunk bed. 18 | # I could pick out what the waitresses wear and, 19 | # After that, I'd come find you and take a break.) 20 | -------------------------------------------------------------------------------- /test/misc/database.pn: -------------------------------------------------------------------------------- 1 | load "database" 2 | load "buffile" 3 | 4 | file = "database.db" 5 | f = fopen(file, "r") # cleanup the left-over 6 | f unlink 7 | 8 | db = Database(file) 9 | db exec "CREATE TABLE t (id INT, name TEXT)" 10 | db exec "INSERT INTO t (id,name) VALUES (1,'New name')" 11 | db close 12 | db open? say #=> false 13 | db open(file) 14 | db open? say #=> true 15 | db exec "INSERT INTO t (id,name) VALUES (2,'Old name')" 16 | db exec "SELECT * FROM t" (row): (row('id'), row('name')) say. 17 | #=> (1, New name) 18 | #=> (2, Old name) 19 | tpl = db gettable "SELECT * FROM t" 20 | tpl each(r): r('id') say. #=> 1 21 | #=> 2 22 | tpl each(r): r('name') say. #=> New name 23 | #=> Old name 24 | db open? say #=> true 25 | db close 26 | db open? say #=> false 27 | 28 | # keep database.db for manual inspection? 29 | -------------------------------------------------------------------------------- /example/spectral-norm.pn: -------------------------------------------------------------------------------- 1 | A = (i, j): 2 | ij = i + j 3 | 1.0 / (ij * (ij + 1) / 2 + i + 1). 4 | 5 | Av = (n, x, y): 6 | i = 0 7 | while (i < n): 8 | a = 0, j = 0 9 | while (j < n): 10 | a += A (i, j) * x (j) 11 | j++. 12 | y (i) = a 13 | i++. 14 | . 15 | 16 | Atv = (n, x, y): 17 | i = 0 18 | while (i < n): 19 | a = 0, j = 0 20 | while (j < n): 21 | a += A (j, i) * x (j) 22 | j++. 23 | y (i) = a 24 | i++. 25 | . 26 | 27 | AtAv = (n, x, y, t): 28 | Av (n, x, t) 29 | Atv (n, t, y). 30 | 31 | n = 100 32 | u = list(n), v = list(n), t = list(n) 33 | i = 0 34 | while (i < n): 35 | u (i) = 1 36 | i++. 37 | 38 | i = 0 39 | while (i < 10): 40 | AtAv (n, u, v, t) 41 | AtAv (n, v, u, t) 42 | i++. 43 | 44 | vBv = 0, vv = 0, i = 0 45 | while (i < n): 46 | ui = u (i), vi = v (i) 47 | vBv += ui * vi 48 | vv += vi * vi 49 | i++. 50 | 51 | a = vBv / vv 52 | a sqrt string slice (0, 11) 53 | -------------------------------------------------------------------------------- /doc/doc.css: -------------------------------------------------------------------------------- 1 | body { 2 | font: normal 14px arial, sans-serif; 3 | line-height: 140%; 4 | margin: 0; padding: 40px 0 180px 0; 5 | } 6 | h1, h4 { 7 | text-align: center; 8 | } 9 | h1 { 10 | color: #390; 11 | } 12 | h1.kana { 13 | color: #9C6; 14 | } 15 | h2 { 16 | color: #F39; 17 | } 18 | h4 { 19 | color: #777; 20 | } 21 | h3 { 22 | margin-top: 30px; 23 | color: #390; 24 | } 25 | h2 { 26 | margin-top: 40px; 27 | } 28 | #potion { 29 | text-align: center; 30 | margin-bottom: 1px; 31 | } 32 | 33 | hr { 34 | height: 3px; 35 | border: none; 36 | border-top: solid 1px #EEE; 37 | border-bottom: solid 1px #F39; 38 | } 39 | #central { 40 | max-width: 740px; 41 | margin: 40px auto; 42 | } 43 | #central p, #central h1, #central h2, #central h3, 44 | #central pre { 45 | margin-left: 20px; 46 | margin-right: 20px; 47 | } 48 | pre { 49 | font: normal 16px Monaco, Liberation Mono, monospace; 50 | background: #CE6; 51 | color: #500; 52 | font-weight: bold; 53 | } 54 | -------------------------------------------------------------------------------- /test/flow/except.pn: -------------------------------------------------------------------------------- 1 | Exception = 2 | class (msg, mark): 3 | /message = msg 4 | /mark = mark 5 | /ignored = false. 6 | 7 | Exception resume = (): 8 | /ignored = true 9 | "RESUMING\n" print 10 | m = /mark 11 | m (). 12 | 13 | SCOPES = () 14 | 15 | throw = (msg): 16 | e = Exception (msg, here) 17 | if (! e /ignored): 18 | s = SCOPES last 19 | c = s (0), s (0) = e 20 | c (). 21 | nil. 22 | 23 | try = (block, catch): 24 | cc = () 25 | c = here 26 | if (! cc (0)): 27 | cc push (c) 28 | SCOPES push (cc) 29 | block () 30 | . else: 31 | catch (SCOPES last (0)). 32 | . 33 | 34 | 1 to (2, (x): 35 | try (: 36 | ("TRY ", x, "\n") join print 37 | if (x == 1): 38 | throw ("TRY ERROR!\n"). 39 | "SUCCESS\n" print. 40 | 41 | (e): 42 | e /message print 43 | e resume. 44 | ) 45 | .) 46 | 47 | nil 48 | 49 | #=> TRY 1 50 | #=> TRY ERROR! 51 | #=> RESUMING 52 | #=> SUCCESS 53 | #=> TRY 2 54 | #=> SUCCESS 55 | #=> nil 56 | -------------------------------------------------------------------------------- /tools/version.sh: -------------------------------------------------------------------------------- 1 | #/bin/sh 2 | ECHO=${1:-echo} 3 | if [ ! -d .git -a ! -e core/version.h ]; then 4 | POTION_COMMIT= 5 | POTION_REV= 6 | POTION_DATE=$(date +%Y-%m-%d) 7 | else 8 | if [ ! -d .git ]; then 9 | exit 10 | else 11 | POTION_COMMIT=$(git rev-list HEAD -1 --abbrev=7 --abbrev-commit) 12 | POTION_REV=$(git rev-list --abbrev-commit HEAD | wc -l | ${SED} "s/ //g") 13 | POTION_DATE=$(date +%Y-%m-%d) 14 | fi 15 | fi 16 | $ECHO "/* created by ${MAKE} -f config.mak */" > core/version.h 17 | $ECHO "#define POTION_MAJOR ${POTION_MAJOR}" >> core/version.h 18 | $ECHO "#define POTION_MINOR ${POTION_MINOR}" >> core/version.h 19 | $ECHO "#define POTION_VERSION \"${POTION_MAJOR}.${POTION_MINOR}\"" >> core/version.h 20 | $ECHO "#define POTION_DATE \"${POTION_DATE}\"" >> core/version.h 21 | $ECHO "#define POTION_COMMIT \"${POTION_COMMIT}\"" >> core/version.h 22 | $ECHO "#define POTION_REV \"${POTION_REV}\"" >> core/version.h 23 | $ECHO "REVISION = ${POTION_REV}" >> config.inc 24 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /bin 2 | /tools/config.c 3 | /config.inc 4 | /config.inc.* 5 | /core/config.h 6 | /core/config.h.bak 7 | /core/version.h 8 | /core/*.i 9 | /core/*.o 10 | /core/*.opic 11 | /core/syntax.c 12 | /test/api/potion-test 13 | /test/api/potion-test.exe 14 | /test/api/gc-test 15 | /test/api/gc-test.exe 16 | /test/api/*.o 17 | /.gdbinit 18 | /.lldbinit 19 | /.ccls-cache 20 | *.pnb 21 | ._* 22 | .DS_Store 23 | /lib/*/*.so 24 | /lib/*/*.dylib 25 | /lib/*/*.dll 26 | /lib/*/*.bundle 27 | /lib/*/*.bundle.dSYM 28 | /lib/*/*.i 29 | /lib/*/*.o 30 | /lib/*/*.opic 31 | /lib/*.i 32 | /lib/*.o 33 | /lib/*.opic 34 | /lib/*.so 35 | /lib/*.so.1* 36 | /lib/*.dylib 37 | /lib/*.dll 38 | /lib/*.bundle 39 | /lib/*.bundle.dSYM 40 | /lib/libpotion.a 41 | /lib/libpotion.so 42 | /lib/libpotion.dll 43 | /lib/libpotion.dylib 44 | /history.txt 45 | /pkg 46 | /doc/*.html 47 | /TAGS 48 | /GPATH 49 | /GRTAGS 50 | /GTAGS 51 | /doc/ref 52 | /doc/html 53 | /doc/latex 54 | /doc/footer.inc 55 | /README.md 56 | /tools/bisect*.sh 57 | /MANIFEST 58 | /mcc.sh 59 | /frama-c* 60 | /cover_db 61 | /xx.[Scp] 62 | /*.patch 63 | -------------------------------------------------------------------------------- /example/24_game.pn: -------------------------------------------------------------------------------- 1 | # See http://rosettacode.org/wiki/24_game#Potion 2 | is_num = (s): 3 | x = s ord(0) 4 | if (x >= "0"ord && x <= "9"ord): true. 5 | else: false. 6 | . 7 | 8 | nums = (s): 9 | res = () 10 | s length times(b): 11 | c = s(b) 12 | if (is_num(c)): 13 | res push(c). 14 | . 15 | res. 16 | 17 | try = 1 18 | while (true): 19 | r = rand string 20 | digits = (r(0),r(1),r(2),r(3)) 21 | "\nMy next four digits: " print 22 | digits join(" ") say 23 | digit_s = digits ins_sort string 24 | 25 | ("Your expression to create 24 (try ", try, "): ") print 26 | entry = read slice(0,-1) 27 | if (entry == "q"): return. 28 | expr = entry eval 29 | parse = nums(entry) 30 | parse_s = parse clone ins_sort string 31 | try++ 32 | if (parse length != 4): 33 | ("Wrong number of digits:", parse) say. 34 | elsif (parse_s != digit_s): 35 | ("Wrong digits:", parse) say. 36 | elsif (expr == 24): 37 | "You won!" say 38 | entry print, " => 24" say 39 | return(). 40 | else: 41 | (entry, " => ", expr string, " != 24") join("") say. 42 | . 43 | -------------------------------------------------------------------------------- /example/gcbench-list.pn: -------------------------------------------------------------------------------- 1 | tree_size = (i): 2 | (1 << (i + 1)) - 1. 3 | 4 | populate_tree = (node, depth): 5 | if (depth > 0): 6 | depth-- 7 | node put(0, list(2)) 8 | node put(1, list(2)) 9 | populate_tree(node(0), depth) 10 | populate_tree(node(1), depth). 11 | . 12 | 13 | new_tree = (depth): 14 | x = list(2) 15 | if (depth > 0): 16 | x put(0, new_tree(depth - 1)) 17 | x put(1, new_tree(depth - 1)). 18 | x. 19 | 20 | "Stretching memory with a binary tree of depth 20\n" print 21 | temp = new_tree(20) 22 | temp = 0 23 | 24 | "Creating a long-lived binary tree of depth 18\n" print 25 | longlived = new_tree(18) 26 | 27 | "Creating a long-lived array of 2000000 items\n" print 28 | ary = list(2000000) 29 | 30 | i = 4 31 | while (i <= 20): 32 | iter = 2 * tree_size(20) / tree_size(i) 33 | ("Creating ", iter, " trees of depth ", i, "\n") join print 34 | 35 | j = 0 36 | while (j < iter): 37 | temp = list(2) 38 | populate_tree(temp, i) 39 | temp = 0 40 | j++. 41 | 42 | j = 0 43 | while (j < iter): 44 | temp = new_tree(i) 45 | temp = 0 46 | j++. 47 | 48 | i = i + 2. 49 | 50 | 0 51 | -------------------------------------------------------------------------------- /example/gcbench.pn: -------------------------------------------------------------------------------- 1 | down_tree = class (depth): 2 | if (depth > 0): 3 | /left = down_tree (depth - 1) 4 | /right = down_tree (depth - 1). 5 | . 6 | 7 | up_tree = class: /left, /right, self. 8 | 9 | populate_tree = (node, depth): 10 | if (depth > 0): 11 | depth-- 12 | populate_tree (node /left = up_tree (), depth) 13 | populate_tree (node /right = up_tree (), depth). 14 | . 15 | 16 | tree_size = (i): 17 | (1 << (i + 1)) - 1. 18 | 19 | "Stretching memory with a binary tree of depth 20\n" print 20 | temp = down_tree (20) 21 | temp = 0 22 | 23 | "Creating a long-lived binary tree of depth 18\n" print 24 | longlived = down_tree (18) 25 | 26 | "Creating a long-lived array of 2000000 items\n" print 27 | ary = list (2000000) 28 | 29 | i = 4 30 | while (i <= 20): 31 | iter = 2 * tree_size (20) / tree_size (i) 32 | ("Creating ", iter, " trees of depth ", i, "\n") join print 33 | 34 | j = 0 35 | while (j < iter): 36 | temp = up_tree () 37 | populate_tree (temp, i) 38 | temp = 0 39 | j++. 40 | 41 | j = 0 42 | while (j < iter): 43 | temp = down_tree (i) 44 | temp = 0 45 | j++. 46 | 47 | i = i + 2. 48 | 49 | 0 50 | -------------------------------------------------------------------------------- /example/binarytrees-list.pn: -------------------------------------------------------------------------------- 1 | n = 20 2 | mindepth = 4 3 | maxdepth = mindepth + 2 4 | if (maxdepth < n): maxdepth = n. 5 | 6 | new_tree = (item, depth): 7 | if (depth > 0): 8 | i = item + item, depth-- 9 | (item, new_tree(i - 1, depth), new_tree(i, depth)). 10 | else: 11 | (item). 12 | . 13 | 14 | item_check = (tree): 15 | if (tree(2)): 16 | tree(0) + item_check(tree(1)) - item_check(tree(2)). 17 | else: 18 | tree(0). 19 | . 20 | 21 | stretch_depth = maxdepth + 1 22 | check = item_check(new_tree(0, stretch_depth)) 23 | ("stretch tree of depth ", stretch_depth, 24 | "\t check: ", check, "\n") join print 25 | 26 | longlivedtree = new_tree(0, maxdepth) 27 | 28 | depth = mindepth, while (depth <= maxdepth): 29 | iter = 1 << (maxdepth - depth + mindepth) 30 | check = 0 31 | i = 1 32 | while (i <= iter): 33 | check = check + item_check(new_tree(1, depth)) + 34 | item_check(new_tree(-1, depth)) 35 | i++. 36 | (iter * 2, "\t trees of depth ", depth, 37 | "\t check: ", check, "\n") join print 38 | depth = depth + 2. 39 | 40 | ("long lived tree of depth ", maxdepth, "\t check: ", 41 | item_check(longlivedtree), "\n") join print 42 | -------------------------------------------------------------------------------- /example/gcbench-table.pn: -------------------------------------------------------------------------------- 1 | tree_size = (i): 2 | (1 << (i + 1)) - 1. 3 | 4 | populate_tree = (node, depth): 5 | if (depth > 0): 6 | depth-- 7 | node put("left", list(2)) 8 | node put("right", list(2)) 9 | populate_tree(node("left"), depth) 10 | populate_tree(node("right"), depth). 11 | . 12 | 13 | new_tree = (depth): 14 | x = (left=nil, right=nil) 15 | if (depth > 0): 16 | x put("left", new_tree(depth - 1)) 17 | x put("right", new_tree(depth - 1)). 18 | x. 19 | 20 | "Stretching memory with a table of depth 20\n" print 21 | temp = new_tree(20) 22 | temp = 0 23 | 24 | "Creating a long-lived table of depth 18\n" print 25 | longlived = new_tree(18) 26 | 27 | "Creating a long-lived array of 2000000 items\n" print 28 | ary = list(2000000) 29 | 30 | i = 4 31 | while (i <= 20): 32 | iter = 2 * tree_size(20) / tree_size(i) 33 | ("Creating ", iter, " tables of depth ", i, "\n") join print 34 | 35 | j = 0 36 | while (j < iter): 37 | temp = (left=nil, right=nil) 38 | populate_tree(temp, i) 39 | temp = 0 40 | j++. 41 | 42 | j = 0 43 | while (j < iter): 44 | temp = new_tree(i) 45 | temp = 0 46 | j++. 47 | 48 | i = i + 2. 49 | 50 | 0 51 | -------------------------------------------------------------------------------- /example/binarytrees.pn: -------------------------------------------------------------------------------- 1 | n = 20 2 | mindepth = 4 3 | maxdepth = mindepth + 2 4 | if (maxdepth < n): maxdepth = n. 5 | 6 | new_tree = class (item, depth): 7 | /item = item 8 | if (depth > 0): 9 | i = item + item, depth-- 10 | /left = new_tree (i - 1, depth) 11 | /right = new_tree (i, depth). 12 | . 13 | 14 | item_check = (tree): 15 | if (tree /left): 16 | tree /item + item_check (tree /left) - item_check (tree /right). 17 | else: 18 | tree /item. 19 | . 20 | 21 | stretch_depth = maxdepth + 1 22 | check = item_check(new_tree(0, stretch_depth)) 23 | ("stretch tree of depth ", stretch_depth, 24 | "\t check: ", check, "\n") join print 25 | 26 | longlivedtree = new_tree(0, maxdepth) 27 | 28 | depth = mindepth, while (depth <= maxdepth): 29 | iter = 1 << (maxdepth - depth + mindepth) 30 | check = 0 31 | i = 1 32 | while (i <= iter): 33 | check = check + item_check(new_tree(1, depth)) + 34 | item_check(new_tree(-1, depth)) 35 | i++. 36 | (iter * 2, "\t trees of depth ", depth, 37 | "\t check: ", check, "\n") join print 38 | depth = depth + 2. 39 | 40 | ("long lived tree of depth ", maxdepth, "\t check: ", 41 | item_check(longlivedtree), "\n") join print 42 | -------------------------------------------------------------------------------- /test/numbers/cmp.pn: -------------------------------------------------------------------------------- 1 | x = 1 < 0 2 | x print 3 | x = 1 <= 0 4 | x print 5 | x = 0 < 1 6 | x print 7 | x = 0 <= 1 8 | x print 9 | x = 0 > 1 10 | x print 11 | x = 0 >= 1 12 | x print 13 | x = 0 == 0 14 | x print 15 | x = 0 != 1 16 | x print 17 | " int-int\n" print 18 | #=> falsefalsetruetruefalsefalsetruetrue int-int 19 | 20 | x = 1.0 < 0 21 | x print 22 | x = 1.0 <= 0 23 | x print 24 | x = 0.0 < 1 25 | x print 26 | x = 0.0 <= 1 27 | x print 28 | x = 0.0 > 1 29 | x print 30 | x = 0.0 >= 1 31 | x print 32 | x = 0.0 == 0 33 | x print 34 | x = 0.0 != 1 35 | x print 36 | " dbl-int\n" print 37 | #=> falsefalsetruetruefalsefalsefalsetrue dbl-int 38 | 39 | x = 1 < 0.0 40 | x print 41 | x = 1 <= 0.0 42 | x print 43 | x = 0 < 1.0 # 44 | x print 45 | x = 0 <= 1.0 46 | x print 47 | x = 0 > 1.0 48 | x print 49 | x = 0 >= 1.0 50 | x print 51 | x = 0 == 0.0 # 52 | x print 53 | x = 0 != 1.0 # 54 | x print 55 | " int-dbl\n" print 56 | #=> falsefalsetruetruefalsefalsefalsetrue int-dbl 57 | 58 | x = 1.0 < 0.0 59 | x print 60 | x = 1.0 <= 0.0 61 | x print 62 | x = 0.0 < 1.0 63 | x print 64 | x = 0.0 <= 1.0 65 | x print 66 | x = 0.0 > 1.0 67 | x print 68 | x = 0.0 >= 1.0 69 | x print 70 | x = 0.0 == 0.0 71 | x print 72 | x = 0.0 != 1.0 73 | x print 74 | " dbl-dbl\n" print 75 | #=> falsefalsetruetruefalsefalsetruetrue dbl-dbl 76 | -------------------------------------------------------------------------------- /doc/Doxyfile: -------------------------------------------------------------------------------- 1 | # Doxyfile 1.8.1.2 2 | PROJECT_NAME = "potion" 3 | PROJECT_NUMBER = 0.3 4 | OUTPUT_DIRECTORY = doc 5 | CREATE_SUBDIRS = YES 6 | FULL_PATH_NAMES = NO 7 | JAVADOC_AUTOBRIEF = YES 8 | OPTIMIZE_OUTPUT_FOR_C = YES 9 | IMAGE_PATH = doc 10 | EXTENSION_MAPPING = p2=Md 11 | MARKDOWN_SUPPORT = YES 12 | INLINE_GROUPED_CLASSES = YES 13 | CASE_SENSE_NAMES = NO 14 | EXTRACT_ALL = YES 15 | EXTRACT_PRIVATE = YES 16 | EXTRACT_STATIC = YES 17 | EXTRACT_LOCAL_CLASSES = YES 18 | EXTRACT_LOCAL_METHODS = YES 19 | SORT_MEMBER_DOCS = NO 20 | 21 | QUIET = YES 22 | WARNINGS = NO 23 | WARN_IF_UNDOCUMENTED = NO 24 | WARN_NO_PARAMDOC = NO 25 | INPUT = core 26 | INPUT += README.md doc/INTERNALS.md INSTALL.md 27 | SOURCE_BROWSER = YES 28 | #INLINE_SOURCES = YES 29 | 30 | HTML_COLORSTYLE_HUE = 157 31 | HTML_COLORSTYLE_SAT = 35 32 | HTML_COLORSTYLE_GAMMA = 59 33 | HTML_DYNAMIC_SECTIONS = YES 34 | GENERATE_TREEVIEW = YES 35 | 36 | DOCSET_FEEDNAME = "Doxygen docs" 37 | #TAGFILES = TAGS 38 | CLASS_DIAGRAMS = YES 39 | HAVE_DOT = YES 40 | DOT_NUM_THREADS = 4 41 | DOT_PATH = /usr/bin/dot 42 | DOT_MULTI_TARGETS = YES 43 | HTML_FOOTER = doc/footer.inc 44 | -------------------------------------------------------------------------------- /example/fannkuch.pn: -------------------------------------------------------------------------------- 1 | # See http://rosettacode.org/wiki/Topswops#Potion 2 | 3 | range = (a, b): 4 | i = 0, l = list(b-a+1) 5 | while (a + i <= b): 6 | l(i) = a + i++. 7 | l. 8 | 9 | fannkuch = (n): 10 | flips = 0, maxf = 0, k = 0, m = n - 1, r = n, check = 0 11 | perml = range(0, n), count = list(n), perm = list(n) 12 | 13 | loop: 14 | #if (check < 30): 15 | # perml join print, "\n" print 16 | # check++. 17 | while (r != 1): 18 | x = r - 1 19 | count(x) = r 20 | r--. 21 | 22 | if (perml (0) != 0 and perml (m) != m): 23 | flips = 0, i = 1 24 | while (i < n): 25 | perm (i) = perml (i) 26 | i++. 27 | k = perml (0) 28 | loop: 29 | i = 1, j = k - 1 30 | while (i < j): 31 | t = perm(i), perm(i) = perm(j), perm(j) = t 32 | i++, j--. 33 | flips++ 34 | j = perm(k), perm(k) = k, k = j 35 | if (k == 0): break. 36 | . 37 | if (flips > maxf): maxf = flips. 38 | . 39 | 40 | loop: 41 | if (r == n): 42 | (n, maxf) say 43 | return (maxf). 44 | 45 | i = 0, j = perml(0) 46 | while (i < r): 47 | k = i + 1 48 | perml(i) = perml(k) 49 | i = k. 50 | perml(r) = j 51 | 52 | j = count(r) - 1 53 | count(r) = j 54 | if (j > 0): break. 55 | r++ 56 | .. n. 57 | 58 | n = argv(1) number 59 | if (n<1): n=10. 60 | 1 to (n, (i): fannkuch(i).) 61 | -------------------------------------------------------------------------------- /example/euler003.pn: -------------------------------------------------------------------------------- 1 | # The prime factors of 13195 are 5, 7, 13 and 29. 2 | # What is the largest prime factor of the number 600851475143 ? 3 | # L 4 | 5 | # NOT YET finished! Syntax error 6 | 7 | #n = 13195 8 | n = 600851475143 9 | #n = 151 10 | 11 | bitarray = class(size=N): 12 | /bits = size 13 | w = size / 32 14 | i = size % 32 15 | if (i > 0): w++ 16 | /a = array( w ) 17 | . 18 | 19 | bitarray at = (i=N): 20 | if (i > /size): "bitarray out of bounds" say, exit. 21 | w = /array(i / 32) 22 | w % 32 23 | . 24 | 25 | bitarray set = (n=N,v): 26 | if (i > /size): "bitarray out of bounds" say, exit. 27 | pos = n / 32 28 | i = n % 32 29 | w = /array(pos) 30 | if (v): /array(pos) = w | i. 31 | else: /array(pos) = w & ~i. 32 | . 33 | 34 | primes = (n): 35 | notprime = bitarray(n), result = (2), max = n sqrt integer 36 | i = 3 37 | while (i < n): 38 | if (notprime at(i)): i++, i++, continue. 39 | if (i <= max): 40 | m = i * i 41 | while (m < n): 42 | notprime set(m, true) 43 | m += i 44 | m += i 45 | . 46 | . 47 | result push(i) 48 | i++, i++ 49 | . 50 | result 51 | . 52 | 53 | i = n / 2 integer 54 | l = primes(i) 55 | is_prime = (i): l bsearch(i) >= 0. 56 | 57 | if (i%2 == 0): i--. 58 | while (i > 1): # and now iterate downwards 59 | if (n%i == 0): 60 | if (is_prime(i)): 61 | i say 62 | #exit 63 | . 64 | . 65 | i--, i-- 66 | . 67 | -------------------------------------------------------------------------------- /tools/asm.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # usage: tools/asm.sh xx.c 3 | # creates annotated at&t x86 assembler listings for 32 and 64bit in xx.32.lst and xx.64.lst 4 | 5 | # example xx.c: 6 | <data; 18 | } else { 19 | reg[op.a] = locals[op.b]; 20 | } 21 | } 22 | EOF 23 | 24 | test -f $1 || (echo "usage $0 cfile.c"; exit) 25 | b=`echo $1|sed 's,\.c,,'` 26 | 27 | case `uname -s` in 28 | Linux|*bsd|CYGWIN*) 29 | gcc -m64 -Icore -S -fverbose-asm -O3 -finline $1 -o $b.64.s && as -64 -acdlhnd $b.64.s > $b.64.lst 30 | gcc -m32 -msse4 -Icore -S -fverbose-asm -O3 -finline $1 -o $b.32.s && as -32 -acdlhnd $b.32.s > $b.32.lst 31 | ;; 32 | Darwin) 33 | gcc-mp-5 -m64 -Icore -S -fverbose-asm -O3 -g -finline $1 -o $b.64.s && \ 34 | gcc-mp-5 -m64 -Icore -C -O3 -g -finline $1 -o $b.64.o && \ 35 | otool -tVj $b.64.o | tee $b.64.lst 36 | gcc-mp-5 -msse4 -m32 -Icore -S -fverbose-asm -O3 -g -finline $1 -o $b.32.s && \ 37 | gcc-mp-5 -msse4 -m32 -Icore -C -O3 -g -finline $1 -o $b.32.o && \ 38 | otool -tVj $b.32.o | tee $b.32.lst 39 | esac 40 | -------------------------------------------------------------------------------- /test/testccs.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # test some compiler configurations on this platform (linux, darwin, win) 3 | # cannot test cross with this yet 4 | if [ -z $CCS ]; then 5 | case `uname -o` in 6 | *Linux) CCS="clang clang-3.3 gcc gcc-4.4 gcc-4.5 gcc-4.6 gcc-4.7 gcc-4.8 gcc-5" ;; 7 | Darwin) CCS="clang clang-3.2 clang-3.4 clang-mp-3.3 clang-mp-3.5 clang-mp-3.6 clang-mp-3.7 8 | gcc gcc-mp-4.3 gcc-mp-4.8 gcc-mp-4.9 gcc-mp-5" ;; 9 | Cygwin) CCS="clang gcc gcc-3" ;; 10 | esac 11 | fi 12 | 13 | cp config.inc config.inc.test 14 | testdebug() { 15 | make -s realclean >/dev/null 2>/dev/null 16 | echo make CC="$1" DEBUG=$2 17 | make -s CC="$1" DEBUG=$2 >/dev/null 2>/dev/null 18 | make -s pn test/api/potion-test >/dev/null 2>/dev/null 19 | make test 20 | echo make CC="$1" DEBUG=$2 21 | echo --------------------- 22 | } 23 | 24 | dotest() { 25 | testdebug "$1" 0 26 | testdebug "$1" 1 27 | } 28 | 29 | for c in $CCS 30 | do 31 | dotest "$c" 32 | done 33 | 34 | rm 3rd/libuv/Makefile 35 | testdebug "gcc -m32" 0 36 | if [ `uname -o` = Darwin ]; then 37 | DYLD_LIBRARY_PATH=/usr/local/lib32 testdebug "gcc -m32" 1 38 | fi 39 | 40 | if test -f /opt/intel/bin/icc; then 41 | rm 3rd/libuv/Makefile 42 | case `uname -m` in 43 | x86_64) /opt/intel/bin/compilervars.sh intel64 44 | ;; 45 | i386) /opt/intel/bin/compilervars.sh ia32 46 | ;; 47 | esac 48 | dotest icc 49 | fi 50 | 51 | rm 3rd/libuv/Makefile 52 | mv config.inc.test config.inc 53 | make 54 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: c 2 | compiler: 3 | - clang 4 | - gcc 5 | 6 | addons: 7 | coverity_scan: 8 | project: 9 | name: "perl11/potion" 10 | description: "_why the lucky stiff's little language" 11 | notification_email: rurban@cpan.org 12 | build_command_prepend: "make clean; make config" 13 | build_command: "make" 14 | branch_pattern: coverity_scan 15 | 16 | os: 17 | - linux 18 | #- osx 19 | 20 | env: 21 | global: 22 | # The next declaration is the encrypted COVERITY_SCAN_TOKEN, created 23 | # via the "travis encrypt" command using the project repo's public key 24 | - secure: "zJea8/1VC70DjPCtKs2ELf+A935AqZ6jE1NkUh0GDDxjrAXkjRmCGJ3GHb/Ob6Xl7XptK4f7hW/+F8jbksob9v4r+T9MoroY1xQjrHDSD4L1wH+Ek9KjhXzxyNllNpT1jtaFHMPRVDI92XngkPqf1RsA3sVWomUUIfZM9N+i+eU=" 25 | env: 26 | - DEBUG=0 27 | - DEBUG=1 28 | 29 | # not yet used: 30 | #before_install: 31 | # - git submodule update --init --recursive 32 | #install: 33 | # - sudo apt-get update -qq 34 | # - sudo apt-get install -qq libdisasm-dev 35 | 36 | script: make config CC=$CC DEBUG=$DEBUG; make && make -j1 test 37 | 38 | notifications: 39 | irc: 40 | channels: 41 | - "irc.perl.org#perl11" 42 | on_success: always 43 | on_failure: always 44 | # to enable skip_join, in IRC channel first execute `/mode -n` 45 | skip_join: true 46 | template: 47 | - "%{repository}#%{build_number} (%{branch} - %{commit} : %{author}): %{message} %{build_url}" 48 | 49 | # DEFAULT TEMPLATE 50 | # - "%{repository}#%{build_number} (%{branch} - %{commit} : %{author}): %{message}" 51 | # - "Change view : %{compare_url}" 52 | # - "Build details : %{build_url}" 53 | -------------------------------------------------------------------------------- /tools/dlfcn-win32/include/dlfcn.h: -------------------------------------------------------------------------------- 1 | /* 2 | * dlfcn-win32 3 | * Copyright (c) 2007 Ramiro Polla 4 | * 5 | * This library is free software; you can redistribute it and/or 6 | * modify it under the terms of the GNU Lesser General Public 7 | * License as published by the Free Software Foundation; either 8 | * version 2.1 of the License, or (at your option) any later version. 9 | * 10 | * This library is distributed in the hope that it will be useful, 11 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 | * Lesser General Public License for more details. 14 | * 15 | * You should have received a copy of the GNU Lesser General Public 16 | * License along with this library; if not, write to the Free Software 17 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 18 | */ 19 | 20 | #ifndef DLFCN_H 21 | #define DLFCN_H 22 | 23 | /* POSIX says these are implementation-defined. 24 | * To simplify use with Windows API, we treat them the same way. 25 | */ 26 | 27 | #define RTLD_LAZY 0 28 | #define RTLD_NOW 0 29 | 30 | #define RTLD_GLOBAL (1 << 1) 31 | #define RTLD_LOCAL (1 << 2) 32 | 33 | /* These two were added in The Open Group Base Specifications Issue 6. 34 | * Note: All other RTLD_* flags in any dlfcn.h are not standard compliant. 35 | */ 36 | 37 | #define RTLD_DEFAULT 0 38 | #define RTLD_NEXT 0 39 | 40 | void *dlopen ( const char *file, int mode ); 41 | int dlclose( void *handle ); 42 | void *dlsym ( void *handle, const char *name ); 43 | char *dlerror( void ); 44 | 45 | #endif /* DLFCN_H */ 46 | -------------------------------------------------------------------------------- /doc/glossary.textile: -------------------------------------------------------------------------------- 1 | See the "pamphlet":start.html for an overview of the potion syntax and data structures. 2 | 3 | - tuple := an ordered list 4 | 5 | - table := a hash 6 | but with list syntax 7 | 8 | - lick := a nested data structure, i.e. named hash. the keys are called @path@. 9 | 10 | Every lick can have a name, a table of attributes, and a list of 11 | children. The list of children can, instead, be a Potion data 12 | type, such as a number or string or something. 13 | 14 | - path := key of a @lick@, an instance variable of an object. 15 | 16 | Paths cannot be randomly added to the object after the object 17 | is created. Each object has a strict set of paths. Every path 18 | which is used in the constructor is added to the object upon 19 | creation. 20 | 21 | - upvalue := A variable in an upper scope. 22 | 23 | Since a closure doesn't have access to the registers 24 | of another function, these variables are passed 25 | as pointers (the @PNWeakRef@ struct.) 26 | 27 | - Lobby := potion named the main interp object @Lobby@, which holds the 28 | methods @about@, @here@, @exit@, @self@, ... 29 | p2 renames it to @"P2"@ 30 | 31 | - mop := potion/p2 uses the "cola mop":http://piumarta.com/software/cola/objmodel2.pdf 32 | with 5 core functions: @addMethod@, @lookup@, @allocate@, @delegated@ and @intern@. 33 | And 4 native (and jitted) VM ops: @SELF@, @CLASS@, @BIND@ and @MSG@. 34 | !p2-mop.png(p2-mop)! 35 | 36 | - flex := the mixin type. A mixin is created with @potion_type_new()@ referencing a parent type, and are handled with @PN_FLEX@ macros. 37 | -------------------------------------------------------------------------------- /core/table.h: -------------------------------------------------------------------------------- 1 | ///\file table.h 2 | /// the central table type, based on core/khash.h 3 | // 4 | // (c) 2008 why the lucky stiff, the freelance professor 5 | // 6 | #ifndef POTION_TABLE_H 7 | #define POTION_TABLE_H 8 | 9 | #include "potion.h" 10 | #include "internal.h" 11 | #include "khash.h" 12 | 13 | #ifndef MAX_INS_SORT 14 | # define MAX_INS_SORT 10 15 | #endif 16 | 17 | typedef PN (*PN_MCACHE_FUNC)(unsigned int hash); 18 | // TODO: ensure the random PNUniq is truly unique for strings 19 | typedef PN (*PN_IVAR_FUNC)(PNUniq hash); 20 | 21 | /// the central vtable, see io http://www.piumarta.com/pepsi/objmodel.pdf 22 | /// \image html p2-mop.png 23 | /// \see objmodel.c 24 | struct PNVtable { 25 | PN_OBJECT_HEADER; ///< PNType vt; PNUniq uniq 26 | PNType parent; ///< parent type, default: for P->lobby: PN_VTABLE(PN_TOBJECT) 27 | PNType type; ///< current type 28 | PN name; ///< classes/types need to be found by name. \see potion_class_find 29 | int ivlen; ///< PN_TUPLE_LEN(ivars) 30 | PN ivars; ///< PNTuple of all our or the parents inherited vars 31 | vPN(Table) methods;///< methods hash, PNTable: name => closures 32 | vPN(Vtable) meta; /// meta PNVtable 33 | PN ctor; ///< store the bound closure (or its parents) 34 | PN call, callset; 35 | PN_MCACHE_FUNC mcache; ///< (yet unused) method cache 36 | PN_IVAR_FUNC ivfunc; 37 | }; 38 | 39 | /// the table class, based on khash 40 | struct PNTable { 41 | PN_OBJECT_HEADER; ///< PNType vt; PNUniq uniq 42 | PN_TABLE_HEADER; ///< PN_SIZE n_buckets, size, n_occupied, upper_bound 43 | char table[]; 44 | }; 45 | 46 | KHASH_MAP_INIT_PN(PN, struct PNTable) 47 | KHASH_MAP_INIT_STR(str, struct PNTable) 48 | 49 | #endif 50 | -------------------------------------------------------------------------------- /core/asm.c: -------------------------------------------------------------------------------- 1 | /** \file asm.c 2 | some assembler functions 3 | 4 | (c) 2008 why the lucky stiff, the freelance professor */ 5 | #include 6 | #include 7 | #include 8 | #include "potion.h" 9 | #include "internal.h" 10 | #include "opcodes.h" 11 | #include "asm.h" 12 | 13 | PNAsm *potion_asm_new(Potion *P) { 14 | int siz = ASM_UNIT - sizeof(PNAsm); 15 | PNAsm * volatile asmb; 16 | PN_FLEX_NEW(asmb, PN_TBYTES, PNAsm, siz); 17 | return asmb; 18 | } 19 | 20 | PNAsm *potion_asm_clear(Potion *P, PNAsm * volatile asmb) { 21 | asmb->len = 0; 22 | PN_MEMZERO_N(asmb->ptr, u8, asmb->siz); 23 | return asmb; 24 | } 25 | 26 | PNAsm *potion_asm_put(Potion *P, PNAsm * volatile asmb, PN val, size_t len) { 27 | u8 *ptr; 28 | PN_FLEX_NEEDS(len, asmb, PN_TBYTES, PNAsm, ASM_UNIT); 29 | ptr = asmb->ptr + asmb->len; 30 | 31 | if (len == sizeof(u8)) 32 | *ptr = (u8)val; 33 | else if (len == sizeof(int)) 34 | *((int *)ptr) = (int)val; 35 | else if (len == sizeof(PN)) 36 | *((PN *)ptr) = val; 37 | else if (len == 2) 38 | *((short *)ptr) = (short)val; 39 | 40 | asmb->len += len; 41 | return asmb; 42 | } 43 | 44 | PNAsm *potion_asm_op(Potion *P, PNAsm * volatile asmb, u8 ins, int _a, int _b) { 45 | PN_OP *pos; 46 | PN_FLEX_NEEDS(sizeof(PN_OP), asmb, PN_TBYTES, PNAsm, ASM_UNIT); 47 | pos = (PN_OP *)(asmb->ptr + asmb->len); 48 | 49 | pos->code = ins; 50 | pos->a = _a; 51 | pos->b = _b; 52 | 53 | asmb->len += sizeof(PN_OP); 54 | return asmb; 55 | } 56 | 57 | PNAsm *potion_asm_write(Potion *P, PNAsm * volatile asmb, char *str, size_t len) { 58 | char *ptr; 59 | PN_FLEX_NEEDS(len, asmb, PN_TBYTES, PNAsm, ASM_UNIT); 60 | ptr = (char *)asmb->ptr + asmb->len; 61 | PN_MEMCPY_N(ptr, str, char, len); 62 | asmb->len += len; 63 | return asmb; 64 | } 65 | -------------------------------------------------------------------------------- /core/opcodes.h: -------------------------------------------------------------------------------- 1 | /** \file/ opcodes.h 2 | the Potion VM instruction set (heavily based on Lua's) 3 | 4 | (c) 2008 why the lucky stiff, the freelance professor 5 | (c) 2014 perl11.org */ 6 | #ifndef POTION_OPCODES_H 7 | #define POTION_OPCODES_H 8 | 9 | enum PN_OPCODE { 10 | OP_NONE, 11 | OP_MOVE, 12 | OP_LOADK, 13 | OP_LOADPN, 14 | OP_SELF, 15 | OP_NEWTUPLE, 16 | OP_GETTUPLE, 17 | OP_SETTUPLE, 18 | OP_GETLOCAL, 19 | OP_SETLOCAL, 20 | OP_GETUPVAL, 21 | OP_SETUPVAL, 22 | OP_GLOBAL, 23 | OP_GETTABLE, 24 | OP_SETTABLE, 25 | OP_NEWLICK, 26 | OP_GETPATH, 27 | OP_SETPATH, 28 | OP_ADD, 29 | OP_SUB, 30 | OP_MULT, 31 | OP_DIV, 32 | OP_REM, 33 | OP_POW, 34 | OP_NOT, 35 | OP_CMP, 36 | OP_EQ, 37 | OP_NEQ, 38 | OP_LT, 39 | OP_LTE, 40 | OP_GT, 41 | OP_GTE, 42 | OP_BITN, 43 | OP_BITL, 44 | OP_BITR, 45 | OP_DEF, 46 | OP_BIND, 47 | OP_MSG, 48 | OP_JMP, 49 | OP_TEST, 50 | OP_TESTJMP, 51 | OP_NOTJMP, 52 | OP_NAMED, 53 | OP_CALL, 54 | OP_CALLSET, 55 | OP_TAILCALL, /* TODO */ 56 | OP_RETURN, 57 | OP_PROTO, /* define a method */ 58 | OP_CLASS, 59 | OP_DEBUG 60 | }; 61 | 62 | #if defined(__GNUC__) 63 | #pragma pack(1) 64 | #else 65 | #pragma pack(push, 1) 66 | #endif 67 | 68 | /// PN_OP - a compressed three-address op (as 32bit int bitfield) 69 | /// TODO: expand to 64bit, check jit then 70 | typedef struct { 71 | enum PN_OPCODE code:8; ///< the op. See vm.c http://www.lua.org/doc/jucs05.pdf 72 | int a:12; ///< the data (i.e the register) 73 | int b:12; ///< optional arg, the message 74 | } PN_OP; 75 | 76 | #if defined(__GNUC__) 77 | #pragma pack() 78 | #else 79 | #pragma pack(pop) 80 | #endif 81 | 82 | #define PN_OP_AT(asmb, n) ((PN_OP *)((PNFlex *)asmb)->ptr)[n] 83 | #define PN_OP_LEN(asmb) (PN_FLEX_SIZE(asmb) / sizeof(PN_OP)) 84 | 85 | #endif 86 | -------------------------------------------------------------------------------- /example/nqueens.pn: -------------------------------------------------------------------------------- 1 | # See http://rosettacode.org/wiki/N-queens_problem#Potion 2 | # Warning: This is not correct yet 3 | # nqueens N verbose-level 4 | # verbose-level 1: print solutions as board 5 | # 2: print every recursion step 6 | 7 | n = argv(1) number 8 | if (n < 1): n = 12. 9 | verbose = argv(2) number > 1 10 | 11 | solutions = (), prev = (), occupied = list(n) 12 | 13 | solve = (depth): 14 | if (depth == n): solutions push(prev), return. 15 | diag = list(n) 16 | # diag: marks cells diagonally attackable by any previous queens. 17 | prev length times(i): 18 | d1 = prev(i) + depth - i 19 | d1 = d1 abs 20 | if (d1 >= 0 and d1 < n): diag(d1) = true. 21 | d2 = prev(i) - depth + i 22 | d2 = d2 abs 23 | if (d1 != d2 and d2 >= 0 and d2 < n): diag(d2) = true. 24 | . 25 | if (verbose): ("depth"=depth,"diag"=diag,"prev"=prev) say. 26 | row = 0 27 | while (row < n): 28 | if (occupied(row) or diag(row)): break. 29 | # prev: row numbers of previous queens 30 | # occupied: rows already used. This gets inherited by each 31 | # recursion so we don't need to repeatedly look them up 32 | prev push(row) 33 | occupied(row) = true 34 | if (verbose): ("row"=row,"prev"=prev,"occupied"=occupied) say. 35 | 36 | solve(1 + depth) 37 | 38 | occupied(row) = false 39 | prev pop 40 | row++ 41 | . 42 | . 43 | 44 | solve(0) 45 | 46 | if (verbose and solutions length > 0): (solutions) say. 47 | ("n"=n, "#solutions"=solutions length, "solutions"=solutions) say 48 | 49 | if (argv(2) number > 0): 50 | solutions length times(x): 51 | s = solutions(x) 52 | n times(i): 53 | si = s(i) 54 | n times(j): 55 | if (si(j)): "|♛" print. 56 | else: "| " print. 57 | . 58 | "|" say 59 | . 60 | . 61 | . 62 | 63 | -------------------------------------------------------------------------------- /tools/mk-release.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # OPTIONS: -ci686-w64-mingw32-gcc ... 3 | if [ -z "$1" ]; then 4 | case `uname -s` in 5 | *Linux) # native to x86_64, cross to i686 via -m32 and win32 via i686-w64-mingw32-gcc 6 | CC="gcc-4.8" #clang-3.3" 7 | CROSS="i686-w64-mingw32-gcc" ;; # x86_64-w64-mingw32-gcc win64 not yet, w64 not used for dist 8 | Darwin) 9 | CC="clang-mp-3.3" #gcc-mp-4.8" 10 | CROSS="i386-mingw32-gcc" ;; 11 | CYGWIN*) # native via gcc4 12 | CC="gcc-4" 13 | if [ `uname -m` = x86_64 ]; then #Cygwin64 14 | CC="gcc" 15 | fi 16 | ;; 17 | esac 18 | #LATER evtl.: ppc, arm, darwin pkg, win64 port 19 | else 20 | while getopts "c:" opt 21 | do 22 | if [ "$opt" = "c" ]; then CROSS="$CROSS ${OPTARG}"; fi 23 | shift 24 | done 25 | OPTS=1 26 | CC=$@ 27 | fi 28 | 29 | dorelease() { 30 | echo 31 | echo RELEASE $1 32 | make realclean 33 | echo make CC="$1" 34 | make CC="$1" DEBUG=0 35 | make test 36 | make static 37 | make docall dist 38 | } 39 | 40 | docross() { 41 | echo CROSS $1 42 | make clean 43 | make clean -C 3rd/libuv 44 | rm config.inc 3rd/libuv/Makefile 45 | echo make CC="$1" DEBUG=0 CROSS=1 46 | make -s -f config.mak CC="$1" DEBUG=0 CROSS=1 47 | touch bin/greg core/syntax.c 48 | make CC="$1" DEBUG=0 CROSS=1 49 | make static 50 | make dist 51 | } 52 | 53 | for c in $CC; do 54 | dorelease "$c" 55 | done 56 | 57 | if [ -n "$CROSS" ]; then 58 | # build greg and syntax.c native 59 | make clean 60 | make core/syntax.c 61 | 62 | for c in $CROSS; do 63 | docross "$c" 64 | done 65 | fi 66 | 67 | if [ -z "$OPTS" ]; then 68 | case `uname -s` in 69 | *Linux) rm 3rd/libuv/Makefile lib/lib* 70 | dorelease "gcc -m32" ;; 71 | esac 72 | fi 73 | -------------------------------------------------------------------------------- /core/ast.h: -------------------------------------------------------------------------------- 1 | /** \file ast.h 2 | the ast for Potion code in-memory 3 | 4 | (c) 2008 why the lucky stiff, the freelance professor */ 5 | #ifndef POTION_AST_H 6 | #define POTION_AST_H 7 | 8 | /// PNArg - call a function (unused). See now macro PN_S(name,1), PN_S(name,2) 9 | typedef struct { 10 | PN v; ///< args 11 | PN b; ///< block 12 | } PNArg; 13 | 14 | 15 | // PN_AST - tree-types, now in potion.h 16 | //enum PN_AST { 17 | //}; 18 | 19 | #define PN_TOK_MISSING 0x10000 20 | 21 | #define PN_AST(T, A, N, L) potion_source(P, AST_##T, A, PN_NIL, PN_NIL, N, L) 22 | #define PN_AST2(T, A, B, N, L) potion_source(P, AST_##T, A, B, PN_NIL, N, L) 23 | #define PN_AST3(T, A, B, C, N, L) potion_source(P, AST_##T, A, B, C, N, L) 24 | #define PN_AST_(T, A) potion_source(P, AST_##T, A, PN_NIL, PN_NIL, -1, PN_NIL) 25 | #define PN_AST2_(T, A, B) potion_source(P, AST_##T, A, B, PN_NIL, -1, PN_NIL) 26 | #define PN_AST3_(T, A, B, C) potion_source(P, AST_##T, A, B, C, -1, PN_NIL) 27 | //! Warning: This might conflict with the typedef struct PN_OP 28 | #define PN_OP(T, A, B) potion_source(P, T, A, B, PN_NIL, 0, PN_NIL) 29 | #define PN_TUPIF(T) PN_IS_TUPLE(T) ? T : PN_TUP(T) 30 | #define PN_SRC(S) ((struct PNSource *)S) 31 | #define PN_PART(S) ((struct PNSource *)S)->part 32 | #define PN_S_(S, N) ((struct PNSource *)S)->a[N] //lvalue 33 | #define PN_S(S, N) (PN)(((struct PNSource *)S)->a[N]) 34 | #define PN_CLOSE(B) ({ \ 35 | PN endname = B; \ 36 | if (PN_IS_TUPLE(endname)) endname = PN_TUPLE_AT(endname, 0); \ 37 | if (endname != PN_NIL) { \ 38 | if (PN_PART(endname) == AST_EXPR) endname = PN_TUPLE_AT(PN_S(endname, 0), 0); \ 39 | if (PN_PART(endname) == AST_MSG || PN_PART(endname) == AST_PATH) \ 40 | endname = PN_S(endname, 0); \ 41 | if (P->unclosed == endname) { P->unclosed = PN_NIL; } \ 42 | } \ 43 | }) 44 | 45 | PN potion_source(Potion *, u8, PN, PN, PN, int, PN); 46 | 47 | #endif 48 | -------------------------------------------------------------------------------- /doc/core-files.txt: -------------------------------------------------------------------------------- 1 | |-------------+----------------------------------------------------| 2 | | File | Description | 3 | |-------------+----------------------------------------------------| 4 | | asm.c | some assembler functions | 5 | | asm.h | some assembler macros | 6 | | ast.c | the ast for Potion code in-memory | 7 | | callcc.c | creation and calling of continuations | 8 | | compile.c | ast to bytecode | 9 | | contrib.c | stuff written by other folks, seen on blogs, etc. | 10 | | file.c | loading code and data from files | 11 | | gc.c | the garbage collector | 12 | | internal.c | memory allocation and innards | 13 | | khash.h | a hashtable library, modified to suit potion's gc | 14 | | lick.c | the interleaved data format | 15 | | mt19937ar.c | C-program for MT19937, with initialization | 16 | | number.c | simple math | 17 | | objmodel.c | much of this is based on the work of ian piumarta | 18 | | potion.c | the Potion! | 19 | | primitive.c | methods for the primitive types | 20 | | string.c | internals of utf-8 and byte strings | 21 | | syntax.c | A recursive-descent parser generated by greg 0.3.0 | 22 | | syntax.g | Potion tokens and grammar | 23 | | table.c | the central table type, based on khash | 24 | | vm-ppc.c | the powerpc jit (32-bit only) | 25 | | vm-x86.c | the x86 and x86_64 jit | 26 | | vm.c | the vm execution loop | 27 | |-------------+----------------------------------------------------| 28 | 29 | -------------------------------------------------------------------------------- /doc/Doxyfile.chm: -------------------------------------------------------------------------------- 1 | # Doxyfile 1.8.4 2 | PROJECT_NAME = "potion" 3 | PROJECT_NUMBER = 0.1 4 | OUTPUT_DIRECTORY = doc 5 | CREATE_SUBDIRS = YES 6 | FULL_PATH_NAMES = NO 7 | JAVADOC_AUTOBRIEF = YES 8 | OPTIMIZE_OUTPUT_FOR_C = YES 9 | IMAGE_PATH = doc 10 | EXTENSION_MAPPING = 11 | MARKDOWN_SUPPORT = YES 12 | INLINE_GROUPED_CLASSES = YES 13 | CASE_SENSE_NAMES = NO 14 | EXTRACT_ALL = YES 15 | EXTRACT_PRIVATE = YES 16 | EXTRACT_STATIC = YES 17 | EXTRACT_LOCAL_CLASSES = YES 18 | EXTRACT_LOCAL_METHODS = YES 19 | SORT_MEMBER_DOCS = NO 20 | 21 | QUIET = YES 22 | WARNINGS = NO 23 | WARN_IF_UNDOCUMENTED = NO 24 | WARN_NO_PARAMDOC = NO 25 | INPUT = "core" \ 26 | "lib" \ 27 | README.md \ 28 | doc/INTERNALS.md \ 29 | INSTALL.md \ 30 | doc/start.html \ 31 | doc/glossary.html 32 | SOURCE_BROWSER = YES 33 | INLINE_SOURCES = NO 34 | GENERATE_TREEVIEW = NO 35 | GENERATE_LATEX = NO 36 | SEARCHENGINE = NO 37 | 38 | HTML_COLORSTYLE_HUE = 157 39 | HTML_COLORSTYLE_SAT = 35 40 | HTML_COLORSTYLE_GAMMA = 59 41 | HTML_DYNAMIC_SECTIONS = YES 42 | 43 | DOCSET_FEEDNAME = "Doxygen docs" 44 | #TAGFILES = TAGS 45 | CLASS_DIAGRAMS = YES 46 | HAVE_DOT = YES 47 | DOT_NUM_THREADS = 4 48 | #? 49 | DOT_IMAGE_FORMAT = png 50 | #DOT_PATH = "/cygdrive/c/Program Files/Graphviz2.34/bin/dot.exe" 51 | DOT_PATH = /usr/bin/dot 52 | DOT_MULTI_TARGETS = YES 53 | HTML_FOOTER = doc/footer.inc 54 | 55 | GENERATE_TODOLIST = NO 56 | GENERATE_HTMLHELP = YES 57 | CHM_FILE = potion.chm 58 | HHC_LOCATION = "/cygdrive/c/Program Files/HTML Help Workshop/hhc.exe" 59 | GENERATE_CHI = NO 60 | CHM_INDEX_ENCODING = UTF-8 61 | BINARY_TOC = YES 62 | TOC_EXPAND = NO 63 | -------------------------------------------------------------------------------- /COPYING: -------------------------------------------------------------------------------- 1 | 2 | Potion is free software, released under an MIT license -- the very 3 | brief paragraphs below. There is satisfaction simply in having 4 | created this. Please use this how you may, even in commercial or 5 | academic software. I've had a good time and am want for nothing. 6 | 7 | ~ 8 | 9 | Copyright (c) 2008 why the lucky stiff 10 | Copyright (c) 2013-2014 perl11.org 11 | 12 | HOWEVER: 13 | Be it known, parts of the object model taken from obj.c 14 | (c) 2007 Ian Piumarta 15 | (MIT licensed) 16 | And, also, the design of the VM bytecode is from Lua 17 | (c) 1994-2006 Lua.org, PUC-Rio 18 | (MIT licensed) 19 | 20 | The Mersenne Twister (MT19937) 21 | (c) 1997-2002, Makoto Matsumoto and Takuji Nishimura (MIT licensed) 22 | 23 | khash.h 24 | (c) 2008, by Attractive Chaos 25 | (MIT licensed) 26 | 27 | Permission is hereby granted, free of charge, to any person 28 | obtaining a copy of this software and associated documentation 29 | files (the "Software"), to deal in the Software without restriction, 30 | including without limitation the rights to use, copy, modify, merge, 31 | publish, distribute, sublicense, and/or sell copies of the Software, 32 | and to permit persons to whom the Software is furnished to do so, 33 | subject to the following conditions: 34 | 35 | The above copyright notice and this permission notice shall be 36 | included in all copies or substantial portions of the Software. 37 | 38 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF 39 | ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED 40 | TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A 41 | PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT 42 | SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR 43 | OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT 44 | OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 45 | WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 46 | SOFTWARE. 47 | 48 | -------------------------------------------------------------------------------- /lib/potion/debug.pn: -------------------------------------------------------------------------------- 1 | # debugger API used if #undef DEBUG_IN_C (not yet enabled) 2 | 3 | #TODO: parse comma delim args. avoid readline (whois loading or calling) 4 | Debug = class (args): 5 | /state = 0 6 | /break = () 7 | /init = (): load "readline". 8 | /read = (): readline("> "). 9 | /write = (o): o print. 10 | 11 | /init() 12 | . 13 | 14 | # API (from lua) 15 | Debug getinfo = (level, name): . 16 | Debug getlocal = (f, i): . 17 | Debug setlocal = (f, i, name): . 18 | Debug setupvalue = (f, i, name): . 19 | Debug traceback = (f| level): . 20 | Debug sethook = (hook, name): . 21 | 22 | # state 0 for next/step 23 | # 1 :c continue until break 24 | # 5 :q exit debugger 25 | # 6 :exit exit program 26 | Debug loop = (src, proto): 27 | if (self/state == 1): 28 | if (self/break bsearch(src line)): return 1. 29 | . 30 | write = self/write 31 | ("\ndebug line ", src file,":", src line string, 32 | " (:h for help, :q,:c,:n)\n") join write 33 | loop: 34 | code = self/read() 35 | if (code == ":c"): 36 | "continue\n" write 37 | self/state = 1 38 | return 1. 39 | if (code == ":q"): 40 | "quit\n" write 41 | return 5. 42 | if (code == ":exit"): 43 | "exit\n" write 44 | return 6. 45 | if (code == ":h"): 46 | (":q quit debugger and continue", 47 | ":exit quit debugger and exit", 48 | ":c continue", 49 | ":b line set breakpoint", 50 | ":B line unset breakpoint", 51 | ":n step to next line", 52 | ":s step into function", 53 | ":r regs", 54 | ":l locals", 55 | ":u upvals", 56 | ":v values (paths)", 57 | "expr eval expr", 58 | "src current ast", 59 | "proto current function\n") join("\n") write 60 | continue. 61 | if (code slice(0,2) == ":b"): 62 | b = code slice(4, code length) number 63 | if (self/break bsearch(b)): ("breakpoint ",b string," already defined\n") join write. 64 | else: self/break = self/break push (b) sort. 65 | continue. 66 | if (code slice(0,2) == ":B"): 67 | b = code slice(4, code length) number 68 | i = self/break bsearch(b) 69 | if (i): 70 | self/break delete(i) 71 | ("breakpoint ", b string, " deleted") join write. 72 | continue. 73 | if (code != ""): 74 | code = code eval string write. 75 | . 76 | 2 77 | . 78 | 79 | debug = Debug -------------------------------------------------------------------------------- /core/lick.c: -------------------------------------------------------------------------------- 1 | ///\file lick.c 2 | /// PNLick class - the interleaved data format 3 | // 4 | // (c) 2008 why the lucky stiff, the freelance professor 5 | // 6 | #include 7 | #include 8 | #include "potion.h" 9 | #include "internal.h" 10 | 11 | PN potion_lick(Potion *P, PN name, PN inner, PN attr) { 12 | vPN(Lick) lk = PN_ALLOC(PN_TLICK, struct PNLick); 13 | lk->name = name; 14 | lk->attr = attr; 15 | lk->inner = inner; 16 | return (PN)lk; 17 | } 18 | 19 | ///\memberof PNLick 20 | /// "attr" method 21 | ///\return the attached attr member PN 22 | PN potion_lick_attr(Potion *P, PN cl, PN self) { 23 | return ((struct PNLick *)self)->attr; 24 | } 25 | 26 | ///\memberof PNLick 27 | /// "licks" method. attached can be a string or PNTuple 28 | ///\return the attached licks PNTuple or PN_NIL 29 | PN potion_lick_licks(Potion *P, PN cl, PN self) { 30 | PN licks = ((struct PNLick *)self)->inner; 31 | if (PN_IS_TUPLE(licks)) return licks; 32 | return PN_NIL; 33 | } 34 | 35 | ///\memberof PNLick 36 | /// "name" method 37 | ///\return PNString 38 | PN potion_lick_name(Potion *P, PN cl, PN self) { 39 | return ((struct PNLick *)self)->name; 40 | } 41 | 42 | ///\memberof PNLick 43 | /// "text" method. attached can be a string or PNTuple 44 | ///\return the attached text PNString or PN_NIL 45 | PN potion_lick_text(Potion *P, PN cl, PN self) { 46 | PN text = ((struct PNLick *)self)->inner; 47 | if (PN_IS_STR(text)) return text; 48 | return PN_NIL; 49 | } 50 | 51 | ///\memberof PNLick 52 | /// "string" method 53 | ///\return space seperated PNString of the lick members: name inner attr 54 | PN potion_lick_string(Potion *P, PN cl, PN self) { 55 | PN out = potion_byte_str(P, ""); 56 | potion_bytes_obj_string(P, out, ((struct PNLick *)self)->name); 57 | if (((struct PNLick *)self)->inner != PN_NIL) { 58 | pn_printf(P, out, " "); 59 | potion_bytes_obj_string(P, out, ((struct PNLick *)self)->inner); 60 | } 61 | if (((struct PNLick *)self)->attr != PN_NIL) { 62 | pn_printf(P, out, " "); 63 | potion_bytes_obj_string(P, out, ((struct PNLick *)self)->attr); 64 | } 65 | return PN_STR_B(out); 66 | } 67 | 68 | void potion_lick_init(Potion *P) { 69 | PN lk_vt = PN_VTABLE(PN_TLICK); 70 | potion_method(lk_vt, "attr", potion_lick_attr, 0); 71 | potion_method(lk_vt, "licks", potion_lick_licks, 0); 72 | potion_method(lk_vt, "name", potion_lick_name, 0); 73 | potion_method(lk_vt, "string", potion_lick_string, 0); 74 | potion_method(lk_vt, "text", potion_lick_text, 0); 75 | } 76 | -------------------------------------------------------------------------------- /doc/types.md: -------------------------------------------------------------------------------- 1 | types representation 2 | -------------------- 3 | 4 | builtin types: 1 bit 5 | user types: short as offset (25000+n). 6 | 7 | we also need a size, for all current types (x or y or ...) 8 | maxsize=15 (we collect only a certain number of types until we 9 | unify some into the next common upper type, and replace them by it) 10 | 11 | # 1-2 words: 12 | struct type { 13 | uint32_t size:4; # 0-15 size of types[] 14 | uint32_t nil:1; 15 | uint32_t num:1; 16 | uint32_t bool:1; 17 | uint32_t dbl:1; 18 | uint32_t bits:24; # and 4-23 other coretype combinations as bit 19 | uint32_t hint:1; # hint in last type 20 | uint32_t free:2; # 21 | short types[0-15];#range: max 32767 user types, max length: 15 22 | }; 23 | 24 | type of types 25 | ------------- 26 | parsed or strictly inferred types 27 | vs compile-time type hints (the most likely types) 28 | vs run-time observed types (traced-based, see luajit. 29 | after some >hits we want to add an optimization on this type.) 30 | 31 | bits reflect 25000 offsets in potion.h 32 | 0 nil 33 | 1 num 34 | 2 bool 35 | 3 dbl 36 | 4 int 37 | 5 str 38 | 7 closure ({sig}, result) 39 | 8 tuple of value (int=>any) 40 | 10 file 41 | 17 table of key=>value (str=>any) 42 | 18 lick of {str,any,any} 43 | ... 44 | 23 any 45 | 24 user++ 46 | 47 | type *unify_types(exp *eo, type *a, type *b, int a_is_upper_limit=TRUE); 48 | type *exact_unify(exp *eo, type *a, type *b); 49 | 50 | typeprim 51 | typeaggr 52 | typeobj 53 | typetuple 54 | typefun 55 | subtype 56 | param 57 | 58 | Links 59 | ----- 60 | http://www.typescriptlang.org/Content/TypeScript%20Language%20Specification.pdf (microsoft's javascript with types) 61 | https://code.facebook.com/posts/1505962329687926/flow-a-new-static-type-checker-for-javascript/ (facebook's javascript with types) 62 | https://github.com/rwaldron/tc39-notes/blob/master/es6/2015-01/JSExperimentalDirections.pdf Soundscript, google's javascript with types 63 | https://www.python.org/dev/peps/pep-0484/ (planned python with types) 64 | http://www.mypy-lang.org/ (existing python with types) 65 | https://news.ycombinator.com/item?id=8620129 (ruby 3.0 planned with types) 66 | http://crystal-lang.org/ (a good existing ruby with types) 67 | http://hacklang.org/ (facebook's php with types) 68 | http://blog.pascal-martin.fr/post/in-favor-of-rfc-scalar-type-hints.html (php 7 types overview) 69 | https://wiki.php.net/rfc/scalar_type_hints (php 7) 70 | https://wiki.php.net/rfc/return_types (php 7) 71 | https://github.com/Microsoft/TypeScript/issues/1265 (Comparison with Facebook Flow Type System) 72 | 73 | -------------------------------------------------------------------------------- /tools/potion-mode.el: -------------------------------------------------------------------------------- 1 | ;;; (autoload 'potion-mode "potion-mode" nil t) 2 | ;;; (add-to-list 'auto-mode-alist '("\\.pn$" . potion-mode)) 3 | 4 | (eval-when-compile 5 | (require 'generic) 6 | (require 'font-lock) 7 | (require 'regexp-opt)) 8 | 9 | (defmacro potion-match-symbol (&rest symbols) 10 | "Convert a word-list into a font-lock regexp." 11 | (concat "\\_<" (regexp-opt symbols t) "\\_>")) 12 | 13 | (define-generic-mode potion-mode 14 | '(?#) ;comments 15 | '("and" "or" "not" "nil" "true" "false") ;keywords 16 | `( ;font-lock-list 17 | ;; block delimiters 18 | ("[.:]" . font-lock-preprocessor-face) 19 | ;; "licks" (data language) 20 | ("[][]" . font-lock-warning-face) 21 | (,(concat 22 | ;; one-char operators 23 | "[,()|?=+~*%<>=!&^-]" 24 | ;; multi-char operators 25 | "\\|\\(" 26 | "\\+\\+\\|--\\|\\*\\*\\|<<\\|>>\\|<=\\|>=\\|==\\|!=\\|<=>\\|&&\\|||" 27 | "\\)") 28 | . font-lock-builtin-face) 29 | ;; slash is magical 30 | ("\\(/\\) " 1 font-lock-builtin-face) 31 | ;; numeric constants 32 | ("\\_<[0-9]+\\(\\.[0-9]*\\)?\\([Ee][+-]?[0-9]+\\)?\\_>" . font-lock-constant-face) 33 | ("0x[a-fA-F0-9]+" . font-lock-constant-face) 34 | ;; attributes 35 | ("/\\(?:\\sw\\|\\s_\\)+\\_>" . font-lock-variable-name-face) 36 | ;; control constructs 37 | (,(potion-match-symbol 38 | "class" "if" "elsif" "else" "loop" "while" "to" "times" "return") 39 | . font-lock-keyword-face) 40 | ;; core functions (XXX some overlap with operators) 41 | (,(potion-match-symbol 42 | "%" "*" "**" "+" "++" "-" "--" "/" "<<" ">>" "about" "abs" "append" "arity" 43 | "at" "attr" "bytes" "call" "chr" "clone" "close" "code" "compile" 44 | "double" "double?" "each" "eval" "exit" "first" "forward" "here" 45 | "integer" "integer?" "join" "kind" "last" "length" "licks" "list" "load" "meta" 46 | "name" "nil" "nil?" "number" "number?" "ord" "pop" "print" "push" "put" "rand" 47 | "read" "remove" "reverse" "self" "send" "slice" "sqrt" "srand" "step" "string" 48 | "string?" "text" "times" "to" "tree" "write" "~") . font-lock-builtin-face) 49 | ) 50 | '("\\.pn$") ;file extension 51 | '((lambda () ;other setup work 52 | (modify-syntax-entry ?' "\"") 53 | (modify-syntax-entry ?: "(.") 54 | (modify-syntax-entry ?\. "):"))) 55 | "Major mode for editing _why's Potion language." 56 | ) 57 | 58 | (provide 'portion-mode) 59 | -------------------------------------------------------------------------------- /lib/readline/linenoise.h: -------------------------------------------------------------------------------- 1 | /* linenoise.h -- guerrilla line editing library against the idea that a 2 | * line editing lib needs to be 20,000 lines of C code. 3 | * 4 | * See linenoise.c for more information. 5 | * 6 | * ------------------------------------------------------------------------ 7 | * 8 | * Copyright (c) 2010, Salvatore Sanfilippo 9 | * Copyright (c) 2010, Pieter Noordhuis 10 | * 11 | * All rights reserved. 12 | * 13 | * Redistribution and use in source and binary forms, with or without 14 | * modification, are permitted provided that the following conditions are 15 | * met: 16 | * 17 | * * Redistributions of source code must retain the above copyright 18 | * notice, this list of conditions and the following disclaimer. 19 | * 20 | * * Redistributions in binary form must reproduce the above copyright 21 | * notice, this list of conditions and the following disclaimer in the 22 | * documentation and/or other materials provided with the distribution. 23 | * 24 | * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 25 | * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 26 | * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 27 | * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 28 | * HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 29 | * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 30 | * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 31 | * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 32 | * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 33 | * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 34 | * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 35 | */ 36 | 37 | #ifndef __LINENOISE_H 38 | #define __LINENOISE_H 39 | 40 | #ifdef _WIN32 41 | # define off off_t 42 | #endif 43 | 44 | typedef struct linenoiseCompletions { 45 | size_t len; 46 | char **cvec; 47 | } linenoiseCompletions; 48 | 49 | typedef void(linenoiseCompletionCallback)(const char *, linenoiseCompletions *); 50 | void linenoiseSetCompletionCallback(linenoiseCompletionCallback *); 51 | void linenoiseAddCompletion(linenoiseCompletions *, char *); 52 | 53 | char *linenoise(const char *prompt); 54 | int linenoiseHistoryAdd(const char *line); 55 | int linenoiseHistorySetMaxLen(int len); 56 | int linenoiseHistorySave(char *filename); 57 | int linenoiseHistoryLoad(char *filename); 58 | void linenoiseClearScreen(void); 59 | 60 | #endif /* __LINENOISE_H */ 61 | -------------------------------------------------------------------------------- /test/api/CuTest.h: -------------------------------------------------------------------------------- 1 | #ifndef CU_TEST_H 2 | #define CU_TEST_H 3 | 4 | /* prints also TAP format with setting the env variable TEST_VERBOSE */ 5 | 6 | #include 7 | #include 8 | 9 | /* CuString */ 10 | 11 | char* CuStrAlloc(int size); 12 | char* CuStrCopy(char* old); 13 | 14 | #define CU_ALLOC(TYPE) ((TYPE*) malloc(sizeof(TYPE))) 15 | 16 | #define HUGE_STRING_LEN 8192 17 | #define STRING_MAX 256 18 | #define STRING_INC 256 19 | 20 | typedef struct 21 | { 22 | int length; 23 | int size; 24 | char* buffer; 25 | } CuString; 26 | 27 | void CuStringInit(CuString* str); 28 | CuString* CuStringNew(void); 29 | void CuStringRead(CuString* str, char* path); 30 | void CuStringAppend(CuString* str, char* text); 31 | void CuStringAppendLen(CuString* str, char* text, long length); 32 | void CuStringAppendChar(CuString* str, char ch); 33 | void CuStringAppendFormat(CuString* str, char* format, ...); 34 | void CuStringResize(CuString* str, int newSize); 35 | void CuStringFree(CuString* str); 36 | 37 | void CuStringFree(CuString *str); 38 | 39 | /* CuTest */ 40 | 41 | typedef struct CuTest CuTest; 42 | 43 | typedef void (*TestFunction)(CuTest *); 44 | 45 | struct CuTest 46 | { 47 | char* name; 48 | TestFunction function; 49 | int failed; 50 | int ran; 51 | char* message; 52 | jmp_buf *jumpBuf; 53 | }; 54 | 55 | void CuTestInit(CuTest* t, char* name, TestFunction function); 56 | CuTest* CuTestNew(char* name, TestFunction function); 57 | void CuFail(CuTest* tc, char* message); 58 | void CuAssert(CuTest* tc, char* message, int condition); 59 | void CuAssertTrue(CuTest* tc, int condition); 60 | void CuAssertStrEquals(CuTest* tc, char* expected, char* actual); 61 | void CuAssertIntEquals(CuTest* tc, char *message, int expected, int actual); 62 | void CuAssertPtrEquals(CuTest* tc, void* expected, void* actual); 63 | void CuAssertPtrNotNull(CuTest* tc, void* pointer); 64 | void CuTestRun(CuTest* tc); 65 | 66 | /* CuSuite */ 67 | 68 | #define MAX_TEST_CASES 1024 69 | 70 | #define SUITE_ADD_TEST(SUITE,TEST) CuSuiteAdd(SUITE, CuTestNew(#TEST, TEST)) 71 | 72 | typedef struct 73 | { 74 | int count; 75 | CuTest* list[MAX_TEST_CASES]; 76 | int failCount; 77 | 78 | } CuSuite; 79 | 80 | 81 | void CuSuiteInit(CuSuite* testSuite); 82 | CuSuite* CuSuiteNew(); 83 | void CuSuiteFree(CuSuite* testSuite); 84 | void CuSuiteAdd(CuSuite* testSuite, CuTest *testCase); 85 | void CuSuiteAddSuite(CuSuite* testSuite, CuSuite* testSuite2); 86 | void CuSuiteRun(CuSuite* testSuite); 87 | void CuSuiteSummary(CuSuite* testSuite, CuString* summary); 88 | void CuSuiteDetails(CuSuite* testSuite, CuString* details); 89 | void CuSuiteFree(CuSuite *testsuite); 90 | 91 | #endif /* CU_TEST_H */ 92 | -------------------------------------------------------------------------------- /test/runtests.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # usage: test/runtests.sh [-q] [testfile] 3 | # cmd="valgrind -q bin/potion" test/runtests.sh 4 | 5 | cmd=${cmd:-bin/potion} 6 | ECHO=/bin/echo 7 | SED=sed 8 | EXPR=expr 9 | 10 | # make -s $cmd 11 | count=0; failed=0; pass=0 12 | EXT=pn; 13 | cmdi="$cmd -I"; cmdx="$cmdi -X"; 14 | cmdc="$cmd -c"; extc=b 15 | QUIET= 16 | if [ "x$1" = "x-q" ]; then QUIET=1; shift; fi 17 | 18 | verbose() { 19 | if [ "x$QUIET" = "x" ]; then ${ECHO} $@; else ${ECHO} -n .; fi 20 | } 21 | 22 | if test -z $1; then 23 | # make -s test/api/potion-test test/api/gc-test 24 | ${ECHO} running potion API tests; 25 | test/api/potion-test; 26 | ${ECHO} running GC tests; 27 | test/api/gc-test; 28 | fi 29 | 30 | while [ $pass -lt 3 ]; do 31 | ${ECHO}; 32 | if [ $pass -eq 0 ]; then 33 | t=0; 34 | whattests="$cmd VM tests" 35 | elif [ $pass -eq 1 ]; then 36 | t=1; 37 | whattests="$cmd compiler tests" 38 | elif [ $pass -eq 2 ]; then 39 | t=2; 40 | whattests="$cmd JIT tests" 41 | jit=`$cmd -v | sed "/jit=1/!d"`; 42 | if [ "$jit" = "" ]; then 43 | pass=`expr $pass + 1` 44 | break 45 | fi; 46 | fi 47 | 48 | if test -n "$1" && test -f "$1"; then 49 | what=$1 50 | if [ ${what%.pn} = $what -a $EXT = pn -a $pass -le 3 ]; then 51 | ${ECHO} skipping potion 52 | break 53 | fi 54 | else 55 | if $(grep "SANDBOX = 1" config.inc >/dev/null); then 56 | what=`ls test/**/*.$EXT|grep -Ev "test/misc/(buffile|load)\.$EXT"` 57 | else 58 | what=test/**/*.$EXT 59 | fi 60 | fi 61 | 62 | ${ECHO} running $whattests 63 | 64 | for f in $what; do 65 | look=`cat $f | sed "/\#=>/!d; s/.*\#=> //"` 66 | #echo look=$look 67 | if [ $t -eq 0 ]; then 68 | verbose $cmdi -B $f 69 | for=`$cmdi -B $f | sed "s/\n$//"` 70 | elif [ $t -eq 1 ]; then 71 | $cmdc $f > /dev/null 72 | fb=$f$extc 73 | verbose $cmdi -B $fb 74 | for=`$cmdi -B $fb | sed "s/\n$//"` 75 | rm -rf $fb 76 | else 77 | verbose $cmdx $f 78 | for=`$cmdx $f | sed "s/\n$//"` 79 | fi; 80 | if [ "$look" != "$for" ]; then 81 | ${ECHO} 82 | ${ECHO} "** $f: expected <$look>, but got <$for>" 83 | failed=`expr $failed + 1` 84 | else 85 | # ${ECHO} -n . 86 | jit=`$cmd -v | ${SED} "/jit=1/!d"` 87 | if [ "$jit" = "" ]; then 88 | ${ECHO} "* skipping" 89 | break 90 | fi 91 | fi 92 | count=`expr $count + 1` 93 | done 94 | pass=`expr $pass + 1` 95 | done 96 | 97 | ${ECHO} 98 | if [ $failed -gt 0 ]; then 99 | ${ECHO} "$failed FAILS ($count tests)" 100 | exit 1 101 | else 102 | ${ECHO} "OK ($count tests)" 103 | fi 104 | 105 | -------------------------------------------------------------------------------- /core/primitive.c: -------------------------------------------------------------------------------- 1 | ///\file primitive.c 2 | /// methods for the immediate primitive types PN_NIL, PNBoolean, PNAny 3 | // 4 | // (c) 2008 why the lucky stiff, the freelance professor 5 | // 6 | #include 7 | #include 8 | #include "potion.h" 9 | #include "internal.h" 10 | 11 | ///memberof PN_NIL 12 | /// "nil?" method (non-p2) 13 | ///\return PN_TRUE for PN_NIL, PN_TRUE for PNAny 14 | static PN potion_nil_is_nil(Potion *P, PN closure, PN self) { 15 | return PN_TRUE; 16 | } 17 | 18 | static PN potion_any_is_nil(Potion *P, PN closure, PN self) { 19 | return PN_FALSE; 20 | } 21 | 22 | /**\memberof Lobby 23 | "cmp" method. compare given value against argument. 24 | \param value PN 25 | \return PNInteger -1 if less, 0 if equal or 1 if greater */ 26 | PN potion_any_cmp(Potion *P, PN cl, PN self, PN value) { 27 | return (self == P->lobby) 28 | ? ((value == P->lobby) ? PN_NUM(0) : PN_NUM(1)) // Lobby is greater than anything 29 | : potion_send(self, PN_cmp, value); 30 | } 31 | /** memberof NilKind 32 | "cmp" method. nil is 0 or "" or FALSE as cmp context 33 | otherwise it is always less. 34 | */ 35 | static PN potion_nil_cmp(Potion *P, PN cl, PN self, PN value) { 36 | switch (potion_type(value)) { 37 | case PN_TNIL: 38 | return 0; 39 | case PN_TNUMBER: 40 | return potion_send(PN_ZERO, PN_cmp, value); 41 | case PN_TBOOLEAN: 42 | return potion_send(PN_FALSE, PN_cmp, value); 43 | case PN_TSTRING: 44 | return potion_send(PN_STR(""), PN_cmp, value); 45 | default: 46 | return PN_NUM(-1); 47 | } 48 | } 49 | 50 | /// fw to num 51 | static PN potion_bool_cmp(Potion *P, PN cl, PN self, PN value) { 52 | switch (potion_type(value)) { 53 | case PN_TBOOLEAN: 54 | return self < value ? -1 : self == value ? 0 : 1; 55 | case PN_TNUMBER: 56 | return potion_send(PN_NUM(PN_TEST(self)), PN_cmp, value); 57 | case PN_TNIL: 58 | case PN_TSTRING: // false < ".." < true 59 | default: 60 | return value == PN_FALSE ? -1 : 1; //false < any < true 61 | } 62 | } 63 | 64 | ///\memberof PNBoolean 65 | /// "number" method 66 | ///\return 0 or 1 67 | static PN potion_bool_number(Potion *P, PN closure, PN self) { 68 | return PN_NUM(PN_TEST(self)); 69 | } 70 | 71 | ///\memberof PNBoolean 72 | /// "string" method 73 | ///\return "true" or "false" as PNString 74 | static PN potion_bool_string(Potion *P, PN closure, PN self) { 75 | if (PN_TEST(self)) return potion_str(P, "true"); 76 | return potion_str(P, "false"); 77 | } 78 | 79 | void potion_primitive_init(Potion *P) { 80 | PN nil_vt = PN_VTABLE(PN_TNIL); 81 | PN boo_vt = PN_VTABLE(PN_TBOOLEAN); 82 | potion_method(nil_vt, "nil?", potion_nil_is_nil, 0); 83 | potion_method(P->lobby, "nil?", potion_any_is_nil, 0); 84 | potion_method(nil_vt, "number", potion_bool_number, 0); 85 | potion_send(nil_vt, PN_def, PN_string, potion_str(P, NIL_NAME)); 86 | potion_method(boo_vt, "number", potion_bool_number, 0); 87 | potion_method(boo_vt, "string", potion_bool_string, 0); 88 | potion_method(P->lobby, "cmp", potion_any_cmp, "value=o"); 89 | potion_method(nil_vt, "cmp", potion_nil_cmp, "value=o"); 90 | potion_method(boo_vt, "cmp", potion_bool_cmp, "value=o"); 91 | } 92 | -------------------------------------------------------------------------------- /example/nbody.pn: -------------------------------------------------------------------------------- 1 | #!/usr/local/bin/potion 2 | # The Computer Language Shootout 3 | # http://shootout.alioth.debian.org/ 4 | # 5 | # contributed by Reini Urban 6 | 7 | pi = 3.141592653589793 8 | solar_mass = 4 * pi * pi 9 | days_per_year = 365.24 10 | 11 | body = class(x=N, y=N, z=N, vx=N, vy=N, vz=N, mass=N): 12 | /x = x 13 | /y = y 14 | /z = z 15 | /vx = vx * days_per_year 16 | /vy = vy * days_per_year 17 | /vz = vz * days_per_year 18 | /mass = mass * solar_mass. 19 | 20 | sun = body(0,0,0, 0,0,0, 1) 21 | jupiter = body(4.84143144246472090, -1.16032004402742839, -1.03622044471123109e-01, 22 | 1.66007664274403694e-03, 7.69901118419740425e-03, -6.90460016972063023e-05, 23 | 9.54791938424326609e-04) 24 | saturn = body(8.34336671824457987, 4.12479856412430479, -4.03523417114321381e-01, 25 | -2.76742510726862411e-03, 4.99852801234917238e-03, 2.30417297573763929e-05, 26 | 2.85885980666130812e-04) 27 | uranus = body(1.28943695621391310e+01, -1.51111514016986312e+01, -2.23307578892655734e-01, 28 | 2.96460137564761618e-03, 2.37847173959480950e-03, -2.96589568540237556e-05, 29 | 4.36624404335156298e-05) 30 | neptune = body(1.53796971148509165e+01, -2.59193146099879641e+01, 1.79258772950371181e-01, 31 | 2.68067772490389322e-03, 1.62824170038242295e-03, -9.51592254519715870e-05, 32 | 5.15138902046611451e-05) 33 | bodies = list(5) 34 | bodies(0) = sun 35 | bodies(1) = jupiter 36 | bodies(2) = saturn 37 | bodies(3) = uranus 38 | bodies(4) = neptune 39 | nbodies = bodies length 40 | lbodies = nbodies - 1 41 | 42 | advance = (dt): 43 | nbodies times(i): 44 | bi = bodies[i] 45 | bix = bi/x 46 | biy = bi/y 47 | biz = bi/z 48 | bivx = bi/vx 49 | bivy = bi/vy 50 | bivz = bi/vz 51 | bimass = bi/mass 52 | j = i+1 53 | while (j < nbodies): 54 | bj = bodies[j] 55 | dx = bix - bj/x 56 | dy = biy - bj/y 57 | dz = biz - bj/z 58 | dist2 = dx*dx + dy*dy + dz*dz 59 | mag = dist2 sqrt 60 | mag = dt / (mag * dist2) 61 | bm = bj/mass * mag 62 | bivx -= dx * bm 63 | bivy -= dy * bm 64 | bivz -= dz * bm 65 | bm = bimass * mag 66 | bj/vx += dx * bm 67 | bj/vy += dy * bm 68 | bj/vz += dz * bm 69 | j++. 70 | bi/x = bix + dt * bivx 71 | bi/y = biy + dt * bivy 72 | bi/z = biz + dt * bivz 73 | bi/vx = bivx 74 | bi/vy = bivy 75 | bi/vz = bivz 76 | .. 77 | 78 | offsetmomentum = (): 79 | px = 0.0 80 | py = 0.0 81 | pz = 0.0 82 | nbodies times(i): 83 | bi = bodies[i] 84 | bimass = bi/mass 85 | px += (bi/vx * bimass) 86 | py += (bi/vy * bimass) 87 | pz += (bi/vz * bimass) 88 | . 89 | b/vx = -px / solar_mass 90 | b/vy = -py / solar_mass 91 | b/vz = -pz / solar_mass 92 | . 93 | 94 | energy = (): 95 | e = 0.0 96 | nbodies times(i): 97 | bi = bodies[i] 98 | bix = bi/x 99 | biy = bi/y 100 | biz = bi/z 101 | bivx = bi/vx 102 | bivy = bi/vy 103 | bivz = bi/vz 104 | bimass = bi/mass 105 | f = bivx * bivx + bivy * bivy + bivz * bivz 106 | e += 0.5 * bimass * f 107 | j = i+1 108 | while (j < nbodies): 109 | bj = bodies[j] 110 | dx = bix - bj/x 111 | dy = biy - bj/y 112 | dz = biz - bj/z 113 | dist = dx*dx + dy*dy + dz*dz 114 | dist = dist sqrt 115 | f = bimass * bj/mass 116 | e -= f / dist 117 | j++. 118 | . 119 | e. 120 | 121 | n = argv(1) number 122 | if (n<1): n=1000. 123 | 124 | offsetmomentum() 125 | energy() say 126 | n times: advance(0.01). 127 | energy() say 128 | -------------------------------------------------------------------------------- /core/asm.h: -------------------------------------------------------------------------------- 1 | /** \file asm.h 2 | some assembler macros 3 | 4 | (c) 2008 why the lucky stiff, the freelance professor 5 | (c) 2014 perl11.org 6 | 7 | PNAsm(vt = PN_TUSER, siz, ptr, len) 8 | -> PNFlex(vt = PN_TUSER, siz, ...) 9 | overhead of 6 words on x86, but don't have to 10 | do constant forwarding tricks. 11 | */ 12 | 13 | #ifndef POTION_ASM_H 14 | #define POTION_ASM_H 15 | 16 | #define ASM_UNIT 512 17 | #define ASM_TPL_IMM 1024 // bitflag for immediate gettuple op.b value 18 | 19 | /// record labels to be patched 20 | typedef struct { 21 | size_t from; 22 | PN_SIZE to; 23 | } PNJumps; 24 | 25 | #define MAKE_TARGET(arch) PNTarget potion_target_##arch = { \ 26 | .setup = potion_##arch##_setup, \ 27 | .stack = potion_##arch##_stack, \ 28 | .registers = potion_##arch##_registers, \ 29 | .local = potion_##arch##_local, \ 30 | .upvals = potion_##arch##_upvals, \ 31 | .jmpedit = potion_##arch##_jmpedit, \ 32 | .op = { \ 33 | (OP_F)NULL, \ 34 | (OP_F)potion_##arch##_move, \ 35 | (OP_F)potion_##arch##_loadk, \ 36 | (OP_F)potion_##arch##_loadpn, \ 37 | (OP_F)potion_##arch##_self, \ 38 | (OP_F)potion_##arch##_newtuple, \ 39 | (OP_F)potion_##arch##_gettuple, \ 40 | (OP_F)potion_##arch##_settuple, \ 41 | (OP_F)potion_##arch##_getlocal, \ 42 | (OP_F)potion_##arch##_setlocal, \ 43 | (OP_F)potion_##arch##_getupval, \ 44 | (OP_F)potion_##arch##_setupval, \ 45 | (OP_F)potion_##arch##_global, \ 46 | (OP_F)potion_##arch##_gettable, \ 47 | (OP_F)potion_##arch##_settable, \ 48 | (OP_F)potion_##arch##_newlick, \ 49 | (OP_F)potion_##arch##_getpath, \ 50 | (OP_F)potion_##arch##_setpath, \ 51 | (OP_F)potion_##arch##_add, \ 52 | (OP_F)potion_##arch##_sub, \ 53 | (OP_F)potion_##arch##_mult, \ 54 | (OP_F)potion_##arch##_div, \ 55 | (OP_F)potion_##arch##_rem, \ 56 | (OP_F)potion_##arch##_pow, \ 57 | (OP_F)potion_##arch##_not, \ 58 | (OP_F)potion_##arch##_cmp, \ 59 | (OP_F)potion_##arch##_eq, \ 60 | (OP_F)potion_##arch##_neq, \ 61 | (OP_F)potion_##arch##_lt, \ 62 | (OP_F)potion_##arch##_lte, \ 63 | (OP_F)potion_##arch##_gt, \ 64 | (OP_F)potion_##arch##_gte, \ 65 | (OP_F)potion_##arch##_bitn, \ 66 | (OP_F)potion_##arch##_bitl, \ 67 | (OP_F)potion_##arch##_bitr, \ 68 | (OP_F)potion_##arch##_def, \ 69 | (OP_F)potion_##arch##_bind, \ 70 | (OP_F)potion_##arch##_message, \ 71 | (OP_F)potion_##arch##_jmp, \ 72 | (OP_F)potion_##arch##_test, \ 73 | (OP_F)potion_##arch##_testjmp, \ 74 | (OP_F)potion_##arch##_notjmp, \ 75 | (OP_F)potion_##arch##_named, \ 76 | (OP_F)potion_##arch##_call, \ 77 | (OP_F)potion_##arch##_callset, \ 78 | (OP_F)potion_##arch##_tailcall, \ 79 | (OP_F)potion_##arch##_return, \ 80 | (OP_F)potion_##arch##_method, \ 81 | (OP_F)potion_##arch##_class \ 82 | }, \ 83 | .finish = potion_##arch##_finish, \ 84 | .mcache = potion_##arch##_mcache, \ 85 | .ivars = potion_##arch##_ivars \ 86 | } 87 | 88 | #define PN_HAS_UPVALS(v) \ 89 | int v = 0; \ 90 | if (PN_TUPLE_LEN(f->protos) > 0) { \ 91 | PN_TUPLE_EACH(f->protos, i, proto2, { \ 92 | if (PN_TUPLE_LEN(PN_PROTO(proto2)->upvals) > 0) { \ 93 | v = 1; \ 94 | } \ 95 | }); \ 96 | } 97 | 98 | #define ASM(ins) *asmp = potion_asm_put(P, *asmp, (PN)(ins), sizeof(u8)) 99 | #define ASM2(pn) *asmp = potion_asm_put(P, *asmp, (PN)(pn), 2) 100 | #define ASMI(pn) *asmp = potion_asm_put(P, *asmp, (PN)(pn), sizeof(int)) 101 | #define ASMN(pn) *asmp = potion_asm_put(P, *asmp, (PN)(pn), sizeof(PN)) 102 | #define ASMS(cstr) *asmp = potion_asm_write(P, *asmp, cstr, sizeof(cstr)-1) 103 | 104 | PNAsm *potion_asm_new(Potion *); 105 | PNAsm *potion_asm_clear(Potion *, PNAsm *); 106 | PNAsm *potion_asm_put(Potion *, PNAsm *, PN, size_t); 107 | PNAsm *potion_asm_op(Potion *, PNAsm *, u8, int, int); 108 | PNAsm *potion_asm_write(Potion *, PNAsm *, char *, size_t); 109 | 110 | #endif 111 | -------------------------------------------------------------------------------- /ChangeLog: -------------------------------------------------------------------------------- 1 | v0.4 2 | * Added native filter and map methods to table and tuple. 3 | * Added a reduce method to tuple. (Peter Arthur) 4 | * Added a database library as sqlite3 binding. (Peter Arthur) 5 | * Fix installation from source without git 6 | * Fixed various SEGVs and minor errors and security issues. 7 | * Fixed cmp for string (Peter Arthur) 8 | 9 | v0.3 Sat Oct 17 10:42:49 CEST 2015 rurban v0.3-g7963cbc-1264 10 | 11 | * Added new syntax tuple[index] for fast, unsafe array access, 12 | also for table with a string literal: table["key"] 13 | * Fixed comparison and equalness esp. for numbers. Check now also double 14 | values, before only int. All values are now compared strictly, numeric types 15 | are not promoted to match. i.e 0 != 0.0 16 | The jit now requires at least a x86 with sse2 (Pentium 4). 17 | * Changed the name Decimal in the API to Double 18 | * Promote integer to double on arithmetic overflow (gcc-5, clang-3.6 or a 19 | single jo insn in the jit) 20 | * Added seperate Double and Integer vtables, which are both of kind Number. 21 | Added specialized methods. 22 | * Added isa? and subclass? methods, re-enabled test/classes/creature.pn 23 | * string: improve performance of at and ord 24 | * Added more examples 25 | * Updated libuv from 0.11.23 to 1.0.0 26 | * New syntax error: Call empty message 27 | * Fixed size method for objects and primitives 28 | * Added parent and methods methods to the Lobby (Peter Arthur) 29 | 30 | v0.2 Thu Sep 11 10:28:32 CDT 2014 rurban v0.2-0-ga280506-1153 31 | 32 | * print and say methods return "" instead of nil. 33 | * Added methods for table: clone, slice, keys, values. 34 | For tuple: slice. For bytes and string: clone. 35 | * Added support for negative arguments for string.slice 36 | * Changed API's for potion_type_error_want 37 | * Updated libuv from 0.11.14 to 0.11.23 38 | * Fixed uv_buf_t handling in aio 39 | * Added SANDBOX support: make SANDBOX=1 40 | omit access to local filesystem, processes, loading shared libraries 41 | -L, and external compilers. bin/potion-s includes all modules statically. 42 | See INSTALL.md 43 | * Added rudimentary src debugger with -d (unfinished, c-version only) 44 | * parse extern functions, but args are not yet translated (unfinished) 45 | * Added typed function calls with compile-time binding (experimental) 46 | * Fixed GC stability issues 47 | 48 | v0.1 Wed Oct 16 13:08:38 2013 rurban v0.1-0-gead95d2-1061 49 | 50 | * Asynchronous non-blocking IO in the aio module via libuv. So like 51 | node, but potion is a bit faster then node. 52 | * Buffered stream FILE* IO in the buffile module. 53 | * Optional and default signature arguments. 54 | * Added argv tuple 55 | * Added cmdline args: -e,-D?,-L,-d,-c,--check 56 | * More examples and documentation 57 | * Fixed various jit-x86 limitations on max number of stack variables, 58 | eg. max 15 on amd64 59 | * Fixed GC errors when running out of memory 60 | * Added support for 3 -DJ disassemblers 61 | * Changed dir layout, seperate bin and lib/potion, use .y for syntax 62 | * Improved build system (PIC and static, faster auto-configure, ...) 63 | * Use Travis testing 64 | * khash.h updated to 0.2.6 65 | * greg updated to 0.4.5 with error blocks, lineno, -DPp support 66 | * Various minor fixes and new methods (sort, cmp, remove, delete, 67 | nreverse, say, ...) 68 | 69 | vFogus Thu Oct 25 14:01:58 2012 fogus vFogus-0-gab7c223-1046 70 | 71 | * Fixed Object() constructor (adrian.bloomer) 72 | * Added class method (adrian.bloomer) 73 | * Added lots of file methods, and more (adrian.bloomer) 74 | * Added vasprintf/asprintf, 'dlfcn-win32' for windows (adrian.bloomer) 75 | * Added 'readline' module and repl (adrian.bloomer) 76 | 77 | vWhy+ Mon Jun 14 11:08:54 2010 fogus 78 | 79 | * Fixed segv in String slice (citizen428) 80 | * Add missing __WORDSIZE definition (joeatework) 81 | 82 | vWhy Tue Aug 11 22:52:29 2009 _why 83 | 84 | * That was _why's last commit 85 | -------------------------------------------------------------------------------- /core/vm-dis.c: -------------------------------------------------------------------------------- 1 | /**\file vm-dis.c 2 | interface to various jit disassembler libs. currently x86 only. usage: -DJ 3 | 4 | - http://udis86.sourceforge.net/ x86 16,32,64 bit 5 | \code port install udis86 \endcode 6 | - http://ragestorm.net/distorm/ x86 16,32,64 bit with all intel/amd extensions 7 | \code apt-get install libdistorm64-dev \endcode 8 | - http://bastard.sourceforge.net/libdisasm.html 386 32bit only 9 | \code apt-get install libdisasm-dev \endcode 10 | 11 | written by Reini Urban 12 | */ 13 | 14 | #if defined(JIT_DEBUG) 15 | printf("-- jit --\n"); 16 | printf("; function definition: %p ; %u bytes\n", asmb->ptr, asmb->len); 17 | # if defined(HAVE_LIBUDIS86) && (POTION_JIT_TARGET == POTION_X86) 18 | { 19 | ud_t ud_obj; 20 | 21 | ud_init(&ud_obj); 22 | ud_set_input_buffer(&ud_obj, asmb->ptr, asmb->len); 23 | ud_set_mode(&ud_obj, __WORDSIZE == 64 ? 64 : 32); 24 | ud_set_syntax(&ud_obj, UD_SYN_ATT); 25 | 26 | while (ud_disassemble(&ud_obj)) { 27 | printf("0x%012lx 0x%lx %-24s \t%s\n", (unsigned long)(ud_insn_off(&ud_obj)+(unsigned long)asmb->ptr), 28 | (long)ud_insn_off(&ud_obj), ud_insn_hex(&ud_obj), ud_insn_asm(&ud_obj)); 29 | } 30 | } 31 | # else 32 | # if defined(HAVE_LIBDISTORM64) && (POTION_JIT_TARGET == POTION_X86) 33 | { 34 | #define MAX_INSTRUCTIONS 2048 35 | #define MAX_TEXT_SIZE (60) 36 | typedef enum {Decode16Bits = 0, Decode32Bits = 1, Decode64Bits = 2} _DecodeType; 37 | typedef enum {DECRES_NONE, DECRES_SUCCESS, DECRES_MEMORYERR, DECRES_INPUTERR} _DecodeResult; 38 | typedef long _OffsetType; 39 | typedef struct { 40 | unsigned int pos; 41 | int8_t p[MAX_TEXT_SIZE]; 42 | } _WString; 43 | typedef struct { 44 | _WString mnemonic; 45 | _WString operands; 46 | _WString instructionHex; 47 | unsigned int size; 48 | _OffsetType offset; 49 | } _DecodedInst; 50 | _DecodeResult distorm_decode64(_OffsetType, 51 | const unsigned char*, 52 | long, 53 | int, 54 | _DecodedInst*, 55 | int, 56 | unsigned int*); 57 | 58 | _DecodedInst disassembled[MAX_INSTRUCTIONS]; 59 | unsigned int decodedInstructionsCount = 0; 60 | _OffsetType offset = 0; 61 | int i; 62 | 63 | distorm_decode64(offset, 64 | (const unsigned char*)asmb->ptr, 65 | asmb->len, 66 | PN_SIZE_T == 8 ? Decode64Bits : Decode32Bits, 67 | disassembled, 68 | MAX_INSTRUCTIONS, 69 | &decodedInstructionsCount); 70 | for (i = 0; i < decodedInstructionsCount; i++) { 71 | printf("0x%012lx 0x%04x (%02d) %-24s %s%s%s\r\n", 72 | disassembled[i].offset + (unsigned long)asmb->ptr, 73 | (unsigned int)disassembled[i].offset, 74 | disassembled[i].size, 75 | (char*)disassembled[i].instructionHex.p, 76 | (char*)disassembled[i].mnemonic.p, 77 | disassembled[i].operands.pos != 0 ? " " : "", 78 | (char*)disassembled[i].operands.p); 79 | } 80 | } 81 | # else 82 | # if defined(HAVE_LIBDISASM) && (POTION_JIT_TARGET == POTION_X86) 83 | # define LINE_SIZE 255 84 | { 85 | char line[LINE_SIZE]; 86 | int pos = 0; 87 | int size = asmb->len; 88 | int insnsize; /* size of instruction */ 89 | x86_insn_t insn; /* one instruction */ 90 | 91 | // only stable for 32bit 92 | x86_init(opt_none, NULL, NULL); 93 | while ( pos < size ) { 94 | insnsize = x86_disasm(asmb->ptr, size, 0, pos, &insn); 95 | if ( insnsize ) { 96 | int i; 97 | x86_format_insn(&insn, line, LINE_SIZE, att_syntax); 98 | printf("0x%x\t", pos); 99 | for ( i = 0; i < 10; i++ ) { 100 | if ( i < insn.size ) printf("%02x", insn.bytes[i]); 101 | else printf(" "); 102 | } 103 | printf("%s\n", line); 104 | pos += insnsize; 105 | } else { 106 | printf("Invalid instruction at 0x%x. size=0x%x\n", pos, size); 107 | pos++; 108 | } 109 | } 110 | x86_cleanup(); 111 | } 112 | #else 113 | long ai = 0; 114 | for (ai = 0; ai < asmb->len; ai++) { 115 | printf("%x ", asmb->ptr[ai]); 116 | } 117 | printf("\n"); 118 | # endif 119 | # endif 120 | # endif 121 | #endif 122 | -------------------------------------------------------------------------------- /core/contrib.c: -------------------------------------------------------------------------------- 1 | /** \file contrib.c 2 | stuff written by other folks, seen on blogs, etc. 3 | */ 4 | #include 5 | #include 6 | #include 7 | #include "config.h" 8 | 9 | #define ONEMASK ((size_t)(-1) / 0xFF) 10 | 11 | /// wonderful utf-8 counting trickery 12 | /// by colin percival 13 | /// 14 | /// http://www.daemonology.net/blog/2008-06-05-faster-utf8-strlen.html 15 | /// 16 | size_t 17 | potion_cp_strlen_utf8(const char * _s) 18 | { 19 | const char * s; 20 | size_t count = 0; 21 | size_t u; 22 | unsigned char b; 23 | 24 | /* Handle any initial misaligned bytes. */ 25 | for (s = _s; (uintptr_t)(s) & (sizeof(size_t) - 1); s++) { 26 | b = *s; 27 | if (b == '\0') goto done; 28 | count += (b >> 7) & ((~b) >> 6); /* NOT the first byte of a character? */ 29 | } 30 | /* Handle complete blocks, vectorizable */ 31 | for (; ; s += sizeof(size_t)) { 32 | __builtin_prefetch(&s[256], 0, 0); 33 | u = *(size_t *)(s); /* Grab 4 or 8 bytes of UTF-8 data. */ 34 | if ((u - ONEMASK) & (~u) & (ONEMASK * 0x80)) break; /* exit on \0 */ 35 | /* count bytes which are NOT the first byte of a character. 36 | TODO: could use a lookup table */ 37 | u = ((u & (ONEMASK * 0x80)) >> 7) & ((~u) >> 6); 38 | count += (u * ONEMASK) >> ((sizeof(size_t) - 1) * 8); 39 | } 40 | /* any left-over bytes. */ 41 | for (; ; s++) { 42 | b = *s; 43 | if (b == '\0') break; 44 | /* Is this byte NOT the first byte of a character? */ 45 | count += (b >> 7) & ((~b) >> 6); /* NOT the first byte of a character? */ 46 | } 47 | done: 48 | return ((s - _s) - count); 49 | } 50 | 51 | #ifdef __MINGW32__ 52 | #include 53 | #include 54 | #define PN_ALIGN(o, x) (((((o) - 1) / (x)) + 1) * (x)) 55 | 56 | void *potion_mmap(size_t length, const char exec) 57 | { 58 | void *mem = VirtualAlloc(NULL, length, MEM_COMMIT, 59 | exec ? PAGE_EXECUTE_READWRITE : PAGE_READWRITE); 60 | if (mem == NULL) { 61 | /* One last attempt at the highest page. 62 | On Windows VirtualAlloc(NULL) sometimes fails due to Illegal System DLL Relocation at a reserved address. */ 63 | SYSTEM_INFO SystemInfo; 64 | size_t high; 65 | int psz; 66 | GetSystemInfo(&SystemInfo); 67 | psz = SystemInfo.dwAllocationGranularity; 68 | high = (size_t)SystemInfo.lpMaximumApplicationAddress - PN_ALIGN(length, psz) + 1; 69 | #ifdef DEBUG 70 | fprintf(stderr, "** potion_mmap(%ld%s) failed, try last page at 0x%x\n", length, exec ? ",exec" : "", high); 71 | #endif 72 | mem = VirtualAlloc((void*)high, length, MEM_COMMIT, 73 | exec ? PAGE_EXECUTE_READWRITE : PAGE_READWRITE); 74 | if (mem == NULL) { 75 | fprintf(stderr, "** potion_mmap(%ld%s) failed\n", length, exec ? ",exec" : ""); 76 | } 77 | } 78 | return mem; 79 | } 80 | 81 | int potion_munmap(void *mem, size_t len) 82 | { 83 | return VirtualFree(mem, len, MEM_DECOMMIT) != 0 ? 0 : -1; 84 | } 85 | 86 | #else 87 | #include 88 | 89 | void *potion_mmap(size_t length, const char exec) 90 | { 91 | int prot = exec ? PROT_EXEC : 0; 92 | void *mem = mmap(NULL, length, prot|PROT_READ|PROT_WRITE, 93 | (MAP_PRIVATE|MAP_ANON), -1, 0); 94 | if (mem == MAP_FAILED) { 95 | fprintf(stderr, "** potion_mmap(%ld%s) failed\n", (long)length, exec ? ",exec" : ""); 96 | return NULL; 97 | } 98 | return mem; 99 | } 100 | 101 | int potion_munmap(void *mem, size_t len) 102 | { 103 | return munmap(mem, len); 104 | } 105 | 106 | #endif 107 | 108 | #if POTION_WIN32 109 | /// vasprintf from nokogiri 110 | /// http://github.com/tenderlove/nokogiri 111 | /// (written by Geoffroy Couprie) 112 | int vasprintf (char **strp, const char *fmt, va_list ap) 113 | { 114 | int len = vsnprintf (NULL, 0, fmt, ap) + 1; 115 | char *res = (char *)malloc((unsigned int)len); 116 | if (res == NULL) 117 | return -1; 118 | *strp = res; 119 | return vsnprintf(res, (unsigned int)len, fmt, ap); 120 | } 121 | 122 | /// asprintf from glibc 123 | int 124 | asprintf (char **string_ptr, const char *format, ...) 125 | { 126 | va_list arg; 127 | int done; 128 | 129 | va_start (arg, format); 130 | done = vasprintf (string_ptr, format, arg); 131 | va_end (arg); 132 | 133 | return done; 134 | } 135 | #endif 136 | -------------------------------------------------------------------------------- /INSTALL.md: -------------------------------------------------------------------------------- 1 | # ~ building potion ~ 2 | 3 | Normally 4 | 5 | $ make 6 | 7 | To build with debugging symbols 8 | 9 | $ make DEBUG=1 10 | 11 | To build without JIT 12 | 13 | $ make JIT=0 14 | 15 | Lastly, to verify your build 16 | 17 | $ make test 18 | 19 | On a typical GNU make < 4.0 sometimes the `test/classes/creatures/` fails. 20 | Try `make -j1 test` or gmake-4.0 then. 21 | 22 | ## ~ the latest potion ~ 23 | 24 | To build the bleeding edge, you will need 25 | GNU make, binutils, perl, sed, git and gcc or better clang. 26 | clang produces better code than gcc, but is harder to debug. 27 | gcc-4.6.3 is broken, at least on ubuntu. 28 | 29 | $ git clone git://github.com/perl11/potion.git 30 | $ cd potion 31 | $ git submodule update --init 32 | $ make 33 | 34 | ## ~ external dependencies ~ 35 | 36 | build-time: gnu make, perl, sed, gcc or clang, echo, cat, expr, git, rsync 37 | perl is only needed because of BSD/darwin sed problems 38 | 39 | run-time: 40 | libuv (later: pcre, libtomath) is included, but external 41 | should choose to use existing packages. see `dist.mak` 42 | 43 | optional: 44 | 45 | libudis on x86 (debugging only) 46 | http://udis86.sourceforge.net/ x86 16,32,64 bit 47 | port install udis86 48 | 49 | libdistorm64 on x86 (debugging only) 50 | http://ragestorm.net/distorm/ x86 16,32,64 bit with all intel/amd extensions 51 | apt-get install libdistorm64-dev 52 | 53 | libdisasm on i386 (debugging only) 54 | http://bastard.sourceforge.net/libdisasm.html 386 32bit only 55 | apt-get install libdisasm-dev 56 | 57 | sloccount (for make sloc) 58 | apt-get install sloccount 59 | 60 | redcloth (for make doc install) 61 | apt-get install ruby-redcloth, or 62 | port install rb-redcloth 63 | 64 | doxygen 1.8 or 1.9 (for make doc install) 65 | apt-get install doxygen, or 66 | port install doxygen 67 | 68 | GNU global (for make docall install) 69 | apt-get install global, or 70 | port install global 71 | 72 | ## ~ sandboxing ~ 73 | 74 | With `gmake SANDBOX=1` a static sandboxed `bin/potion-s` is built, which 75 | excludes all local filesystem and process accesses and includes all external 76 | modules in one executable. `load` is also disabled, so modules must include 77 | all dependent libraries. 78 | 79 | Network access is enabled via Aio. If you want to disable 80 | networking also, remove `lib/aio.c` from the SANDBOX SRC in `Makefile`, 81 | and `Potion_Init_aio(P)` from `core/internal.c` 82 | 83 | ## ~ installing ~ 84 | 85 | $ sudo make install 86 | 87 | ## ~ building on windows ~ 88 | 89 | Potion's win32 binaries are built using MinGW. 90 | 91 | 92 | It's a bit hard to setup mingw and gmake on Windows. 93 | I usually run a shell under Cygwin and add MinGW 94 | to my `$PATH`. 95 | 96 | Once that's all done, 97 | 98 | $ make 99 | 100 | The easiest way to do this, actually, is on Linux or Darwin. 101 | On Ubuntu, if you have MinGW installed, 102 | 103 | $ make clean; make core/syntax.c 104 | $ make config CC=i686-w64-mingw32-gcc CROSS=1 105 | $ touch core/syntax.c 106 | $ make && make dist 107 | 108 | This will first create a native greg and `core/syntax.c`, 109 | sets `CROSS=1` and cross-compile with the given CC. 110 | See `tools/mk-release.sh` 111 | 112 | `make test` will not work, you need to copy a make dist tarball 113 | to the machine and test it there. 114 | 115 | win64 is not supported yet. It uses a slighlty different ABI, 116 | cygwin64 misses pthread\_barrier\_t. 117 | and x86_64-w64-mingw32-gcc fails by creating a wrong `config.h` 118 | 119 | ## ~ building on bsd ~ 120 | 121 | BSD make is not supported. 122 | You can either install gnu make (gmake) 123 | 124 | $ sudo port install gmake 125 | 126 | or try `./configure` which creates a special BSD `config.mk` 127 | 128 | or try to merge `master` with the branch `bsd` 129 | 130 | $ git merge bsd 131 | ... resolve conflicts, or not 132 | 133 | ## ~ building with a strict C++ compiler ~ 134 | 135 | potion does not support strict C++ compilers. 136 | If you have no modern C compiler: 137 | 138 | Either add a C dialect to CC in config.inc (i.e. `-std=c89`), 139 | 140 | g++ --help=C; clang++ -x C -std=gnu89 141 | 142 | or try to merge with the branch `p2-c++`. 143 | 144 | ## ~ creating documentation ~ 145 | 146 | This is required for `make dist` and release admins. 147 | You'll need: 148 | 149 | redcloth to convert .textile to html, 150 | doxygen (1.8 or 1.9), and 151 | GNU global for gtags and htags 152 | 153 | On windows et al.: `gem install RedCloth` 154 | -------------------------------------------------------------------------------- /core/internal.h: -------------------------------------------------------------------------------- 1 | /** \file internal.h 2 | non-API internal parts 3 | 4 | (c) 2008 why the lucky stiff, the freelance professor */ 5 | #ifndef POTION_INTERNAL_H 6 | #define POTION_INTERNAL_H 7 | 8 | struct Potion_State; 9 | 10 | typedef unsigned char u8; 11 | 12 | #define PN_ALLOC(V,T) (T * volatile)potion_gc_alloc(P, V, sizeof(T)) 13 | #define PN_ALLOC_N(V,T,C) (T * volatile)potion_gc_alloc(P, V, sizeof(T)+C) 14 | #define PN_CALLOC_N(V,T,C) (T * volatile)potion_gc_calloc(P, V, sizeof(T)+C) 15 | #define PN_REALLOC(X,V,T,N) (X)=(T * volatile)potion_gc_realloc(P, V, (struct PNObject *)(X), sizeof(T) + N) 16 | #define PN_DALLOC_N(T,N) potion_data_alloc(P, sizeof(T)*N) 17 | #define PN_STRDUP(S) PN_STR(S) 18 | 19 | #define PN_MEMZERO(X,T) memset((X), 0, sizeof(T)) 20 | #define PN_MEMZERO_N(X,T,N) memset((X), 0, sizeof(T)*(N)) 21 | #define PN_MEMCPY(X,Y,T) memcpy((void *)(X), (void *)(Y), sizeof(T)) 22 | #define PN_MEMCPY_N(X,Y,T,N) memcpy((void *)(X), (void *)(Y), sizeof(T)*(N)) 23 | #define PN_MEMMOVE_N(DST,SRC,T,N) memmove((void *)(DST), (void *)(SRC), sizeof(T)*(N)) 24 | 25 | #ifndef min 26 | #define min(a, b) ((a) <= (b) ? (a) : (b)) 27 | #endif 28 | 29 | #ifndef max 30 | #define max(a, b) ((a) >= (b) ? (a) : (b)) 31 | #endif 32 | 33 | #define TYPE_BATCH_SIZE 4096 34 | 35 | #define PN_FLEX_NEW(N, V, T, S) \ 36 | (N) = PN_ALLOC_N(V, T, (sizeof(*(N)->ptr) * S)); \ 37 | (N)->siz = sizeof(*(N)->ptr) * S; \ 38 | (N)->len = 0 39 | 40 | #define PN_FLEX_NEEDS(X, N, V, T, S) ({ \ 41 | PN_SIZE capa = (N)->siz / sizeof(*(N)->ptr); \ 42 | if (capa < (N)->len + X) { \ 43 | while (capa < (N)->len + X) \ 44 | capa += S; \ 45 | capa = sizeof(*(N)->ptr) * capa; \ 46 | PN_REALLOC(N, V, T, capa); \ 47 | (N)->siz = capa; \ 48 | } \ 49 | }) 50 | 51 | #define PN_ATOI(X,N,B) ({ \ 52 | char *Ap = X; \ 53 | long Ai = 0; int Am = 1; \ 54 | size_t Al = N; \ 55 | if (*Ap == '-') { Am = -1; Ap++; Al--; } \ 56 | while (Al--) { \ 57 | if ((*Ap >= '0') && (*Ap <= '9')) \ 58 | Ai = (Ai * B) + (*Ap - '0'); \ 59 | else if ((*Ap >= 'A') && (*Ap <= 'F')) \ 60 | Ai = (Ai * B) + ((*Ap - 'A') + 10); \ 61 | else if ((*Ap >= 'a') && (*Ap <= 'f')) \ 62 | Ai = (Ai * B) + ((*Ap - 'a') + 10); \ 63 | else break; \ 64 | Ap++; \ 65 | } \ 66 | Ai * Am; \ 67 | }) 68 | 69 | /// .pnb binary dump header 70 | struct PNBHeader { 71 | u8 sig[4]; 72 | u8 major; 73 | u8 minor; 74 | u8 vmid; 75 | u8 pn; 76 | u8 proto[]; 77 | }; 78 | 79 | size_t potion_cp_strlen_utf8(const char *); 80 | void *potion_mmap(size_t, const char); 81 | int potion_munmap(void *, size_t); 82 | // i686-w64-mingw32 /include/stdio.h has asprintf defined 83 | // i386-mingw32 not 84 | #if POTION_WIN32 && !defined(__MINGW_SCANF_FORMAT) 85 | int vasprintf (char **strp, const char *fmt, __VALIST ap); 86 | int asprintf (char **string_ptr, const char *format, ...); 87 | #endif 88 | #define PN_ALLOC_FUNC(size) potion_mmap(size, 1) 89 | 90 | // 91 | // stack manipulation routines 92 | // 93 | #if POTION_X86 == POTION_JIT_TARGET 94 | #if PN_SIZE_T == 8 95 | // preserve: rbx r12 r13 r14 r15. scratch: rax rcx rdx r8 r9 r10 r11. 96 | #define PN_SAVED_REGS 5 97 | #if defined(__SANITIZE_ADDRESS__) && defined(__APPLE__) 98 | #define POTION_ESP(p) __asm__("mov %%rsp, %0" : "=r" (*p)); *p += 0x178 99 | #else 100 | #if defined(__SANITIZE_ADDRESS__) && defined(__linux__) 101 | #define POTION_ESP(p) __asm__("mov %%rsp, %0" : "=r" (*p)); *p += 0xd0 102 | #else 103 | #define POTION_ESP(p) __asm__("mov %%rsp, %0" : "=r" (*p)) 104 | #endif 105 | #endif 106 | #define POTION_EBP(p) __asm__("mov %%rbp, %0" : "=r" (*p)) 107 | #else 108 | #define PN_SAVED_REGS 3 109 | #if defined(__SANITIZE_ADDRESS__) && defined(__APPLE__) 110 | #define POTION_ESP(p) __asm__("mov %%esp, %0" : "=r" (*p)); *p += 0x178 111 | #else 112 | #if defined(__SANITIZE_ADDRESS__) && defined(__linux__) 113 | #define POTION_ESP(p) __asm__("mov %%esp, %0" : "=r" (*p)); *p += 0xd0 114 | #else 115 | #define POTION_ESP(p) __asm__("mov %%esp, %0" : "=r" (*p)) 116 | #endif 117 | #endif 118 | #define POTION_EBP(p) __asm__("mov %%ebp, %0" : "=r" (*p)) 119 | #endif 120 | #else 121 | #define PN_SAVED_REGS 0 122 | __attribute__ ((noinline)) void potion_esp(void **); 123 | #define POTION_ESP(p) potion_esp((void **)p) 124 | #define POTION_EBP(p) potion_esp((void **)p) 125 | #endif 126 | 127 | #ifndef O_BINARY 128 | #define O_BINARY 0 129 | #endif 130 | 131 | #if POTION_STACK_DIR > 0 132 | #define STACK_UPPER(a, b) a 133 | #elif POTION_STACK_DIR < 0 134 | #define STACK_UPPER(a, b) b 135 | #endif 136 | 137 | #define GC_PROTECT(P) P->mem->protect = (void *)P->mem->birth_cur 138 | 139 | /* for the jit and bytecode, too large to be inlined into the jit */ 140 | PN potion_vm_eq(Potion *, PN, PN); 141 | PN potion_vm_neq(Potion *, PN, PN); 142 | 143 | #endif 144 | -------------------------------------------------------------------------------- /tools/greg.h: -------------------------------------------------------------------------------- 1 | /* Copyright (c) 2007 by Ian Piumarta 2 | * Copyright (c) 2011 by Amos Wenger nddrylliog@gmail.com 3 | * Copyright (c) 2013 by perl11 org 4 | * All rights reserved. 5 | * 6 | * Permission is hereby granted, free of charge, to any person obtaining a 7 | * copy of this software and associated documentation files (the 'Software'), 8 | * to deal in the Software without restriction, including without limitation 9 | * the rights to use, copy, modify, merge, publish, distribute, and/or sell 10 | * copies of the Software, and to permit persons to whom the Software is 11 | * furnished to do so, provided that the above copyright notice(s) and this 12 | * permission notice appear in all copies of the Software. Acknowledgement 13 | * of the use of this Software in supporting documentation would be 14 | * appreciated but is not required. 15 | * 16 | * THE SOFTWARE IS PROVIDED 'AS IS'. USE ENTIRELY AT YOUR OWN RISK. 17 | * 18 | * Last edited: 2013-04-11 11:10:34 rurban 19 | */ 20 | 21 | #include 22 | #ifdef WIN32 23 | # undef inline 24 | # define inline __inline 25 | #endif 26 | 27 | #define GREG_MAJOR 0 28 | #define GREG_MINOR 4 29 | #define GREG_LEVEL 5 30 | 31 | typedef enum { Freed = -1, Unknown= 0, Rule, Variable, Name, Dot, Character, String, Class, Action, Predicate, Error, Alternate, Sequence, PeekFor, PeekNot, Query, Star, Plus, Any } NodeType; 32 | 33 | enum { 34 | RuleUsed = 1<<0, 35 | RuleReached = 1<<1, 36 | }; 37 | 38 | typedef union Node Node; 39 | 40 | #define NODE_COMMON NodeType type; Node *next 41 | struct Rule { NODE_COMMON; char *name; Node *variables; Node *expression; int id; int flags; }; 42 | struct Variable { NODE_COMMON; char *name; Node *value; int offset; }; 43 | struct Name { NODE_COMMON; Node *rule; Node *variable; }; 44 | struct Dot { NODE_COMMON; }; 45 | struct Character { NODE_COMMON; char *value; }; 46 | struct String { NODE_COMMON; char *value; }; 47 | struct Class { NODE_COMMON; unsigned char *value; }; 48 | struct Action { NODE_COMMON; char *text; Node *list; char *name; Node *rule; }; 49 | struct Predicate { NODE_COMMON; char *text; }; 50 | struct Error { NODE_COMMON; Node *element; char *text; }; 51 | struct Alternate { NODE_COMMON; Node *first; Node *last; }; 52 | struct Sequence { NODE_COMMON; Node *first; Node *last; }; 53 | struct PeekFor { NODE_COMMON; Node *element; }; 54 | struct PeekNot { NODE_COMMON; Node *element; }; 55 | struct Query { NODE_COMMON; Node *element; }; 56 | struct Star { NODE_COMMON; Node *element; }; 57 | struct Plus { NODE_COMMON; Node *element; }; 58 | struct Any { NODE_COMMON; }; 59 | #undef NODE_COMMON 60 | 61 | union Node 62 | { 63 | NodeType type; 64 | struct Rule rule; 65 | struct Variable variable; 66 | struct Name name; 67 | struct Dot dot; 68 | struct Character character; 69 | struct String string; 70 | struct Class cclass; 71 | struct Action action; 72 | struct Predicate predicate; 73 | struct Error error; 74 | struct Alternate alternate; 75 | struct Sequence sequence; 76 | struct PeekFor peekFor; 77 | struct PeekNot peekNot; 78 | struct Query query; 79 | struct Star star; 80 | struct Plus plus; 81 | struct Any any; 82 | }; 83 | 84 | extern Node *actions; 85 | extern Node *rules; 86 | extern Node *start; 87 | 88 | extern int ruleCount; 89 | 90 | extern FILE *output; 91 | 92 | extern Node *makeRule(char *name, int starts); 93 | extern Node *findRule(char *name, int starts); 94 | extern Node *beginRule(Node *rule); 95 | extern void Rule_setExpression(Node *rule, Node *expression); 96 | extern Node *Rule_beToken(Node *rule); 97 | extern Node *makeVariable(char *name); 98 | extern Node *makeName(Node *rule); 99 | extern Node *makeDot(void); 100 | extern Node *makeCharacter(char *text); 101 | extern Node *makeString(char *text); 102 | extern Node *makeClass(char *text); 103 | extern Node *makeAction(char *text); 104 | extern Node *makePredicate(char *text); 105 | extern Node *makeError(Node *e, char *text); 106 | extern Node *makeAlternate(Node *e); 107 | extern Node *Alternate_append(Node *e, Node *f); 108 | extern Node *makeSequence(Node *e); 109 | extern Node *Sequence_append(Node *e, Node *f); 110 | extern Node *makePeekFor(Node *e); 111 | extern Node *makePeekNot(Node *e); 112 | extern Node *makeQuery(Node *e); 113 | extern Node *makeStar(Node *e); 114 | extern Node *makePlus(Node *e); 115 | extern Node *push(Node *node); 116 | extern Node *top(void); 117 | extern Node *pop(void); 118 | 119 | extern void Rule_compile_c_header(void); 120 | extern void Rule_compile_c(Node *node); 121 | 122 | extern void Node_print(Node *node); 123 | extern void Rule_print(Node *node); 124 | extern void Rule_free(Node *node); 125 | extern void freeRules(void); 126 | -------------------------------------------------------------------------------- /test/api/gc-test.c: -------------------------------------------------------------------------------- 1 | // 2 | // gc-test.c 3 | // rudimentary garbage collection testing 4 | // (see core/gc.c for the lightweight garbage collector, 5 | // based on ideas from Qish by Basile Starynkevitch.) 6 | // 7 | // (c) 2008 why the lucky stiff, the freelance professor 8 | // 9 | #include 10 | #include 11 | #include 12 | #include "potion.h" 13 | #include "internal.h" 14 | #include "gc.h" 15 | #include "CuTest.h" 16 | 17 | Potion *P; 18 | 19 | #if defined(DEBUG) 20 | #define DBG_Gv(P,...) \ 21 | if (P->flags & (DEBUG_GC | DEBUG_VERBOSE)) { \ 22 | printf(__VA_ARGS__); \ 23 | } 24 | #define DBG_G(P,...) \ 25 | if (P->flags & DEBUG_GC) { \ 26 | printf(__VA_ARGS__); \ 27 | } 28 | #else 29 | #define DBG_Gv(...) 30 | #define DBG_G(...) 31 | #endif 32 | 33 | void gc_test_start(CuTest *T) { 34 | CuAssert(T, "GC struct isn't at start of first page", P->mem == P->mem->birth_lo); 35 | CuAssert(T, "stack length is not a positive number", potion_stack_len(P, NULL) > 0); 36 | } 37 | 38 | // 39 | // everything allocated in alloc1 and alloc4 tests goes out of scope, so will 40 | // not be moved to the old generation. data in the `forward` test will be copied. 41 | // 42 | void gc_test_alloc1(CuTest *T) { 43 | PN ptr = (PN)potion_gc_alloc(P, PN_TUSER, 16); 44 | PN_SIZE count = potion_mark_stack(P, 0); 45 | CuAssert(T, "couldn't allocate 16 bytes from GC", PN_IS_PTR(ptr)); 46 | CuAssert(T, "only one or two allocations should be found", count >= 1 && count <= 2); 47 | } 48 | 49 | void gc_test_gc_minor(CuTest *T) { 50 | potion_str_hash_init(P); 51 | PN ptr = (PN)potion_gc_alloc(P, PN_TUSER, 16); 52 | PN s1 = PN_STR("teststring"); 53 | potion_garbagecollect(P, POTION_PAGESIZE, 0); 54 | CuAssert(T, "couldn't allocate 16 bytes from GC", PN_IS_PTR(ptr)); 55 | CuAssert(T, "s1", PN_IS_STR(s1)); 56 | } 57 | void gc_test_gc_major(CuTest *T) { 58 | POTION_INIT_STACK(sp); 59 | P = potion_create(sp); 60 | PN ptr = (PN)potion_gc_alloc(P, PN_TUSER, 16); 61 | potion_garbagecollect(P, POTION_PAGESIZE, 1); 62 | CuAssert(T, "couldn't allocate 16 bytes from GC", PN_IS_PTR(ptr)); 63 | } 64 | 65 | void gc_test_alloc4(CuTest *T) { 66 | PN ptr = (PN)potion_gc_alloc(P, PN_TUSER, 16); 67 | PN ptr2 = (PN)potion_gc_alloc(P, PN_TUSER, 16); 68 | PN ptr3 = (PN)potion_gc_alloc(P, PN_TUSER, 16); 69 | PN ptr4 = (PN)potion_gc_alloc(P, PN_TUSER, 16); 70 | PN_SIZE count = potion_mark_stack(P, 0); 71 | CuAssert(T, "couldn't allocate 16 bytes from GC", PN_IS_PTR(ptr)); 72 | CuAssert(T, "couldn't allocate 16 bytes from GC", PN_IS_PTR(ptr2)); 73 | CuAssert(T, "couldn't allocate 16 bytes from GC", PN_IS_PTR(ptr3)); 74 | CuAssert(T, "couldn't allocate 16 bytes from GC", PN_IS_PTR(ptr4)); 75 | CuAssert(T, "min. four allocations should be found", count >= 4); 76 | } 77 | 78 | void gc_test_forward(CuTest *T) { 79 | char *fj = "frances johnson."; 80 | vPN(Data) ptr = potion_data_alloc(P, 16); 81 | register unsigned long old = (PN)ptr & 0xFFFF; 82 | memcpy(ptr->data, fj, 16); 83 | 84 | //DBG_Gv(P,"forward ptr->data: %p \"%s\"\n", &ptr->data, ptr->data); 85 | potion_mark_stack(P, 1); 86 | //DBG_Gv(P,"marked ptr->data: %p \"%s\"\n", &ptr->data, ptr->data); 87 | CuAssert(T, "copied location identical to original", (old & 0xFFFF) != (PN)ptr); 88 | CuAssertIntEquals(T, "copied object not still PN_TUSER", ptr->vt, PN_TUSER); 89 | CuAssert(T, "copied data not identical to original", 90 | strncmp(ptr->data, fj, 16) == 0); 91 | } 92 | 93 | CuSuite *gc_suite() { 94 | CuSuite *S = CuSuiteNew(); 95 | SUITE_ADD_TEST(S, gc_test_start); 96 | #ifndef __SANITIZE_ADDRESS__ 97 | SUITE_ADD_TEST(S, gc_test_alloc1); 98 | SUITE_ADD_TEST(S, gc_test_alloc4); 99 | #endif 100 | SUITE_ADD_TEST(S, gc_test_forward); 101 | SUITE_ADD_TEST(S, gc_test_gc_minor); 102 | SUITE_ADD_TEST(S, gc_test_gc_major); 103 | return S; 104 | } 105 | 106 | int main(int argc, char **argv) { 107 | POTION_INIT_STACK(sp); 108 | int count; 109 | 110 | // manually initialize the older generation 111 | P = potion_gc_boot(sp); 112 | if (argc == 2) { 113 | #ifdef DEBUG 114 | if (!strcmp(argv[1], "-DG")) P->flags |= DEBUG_GC; 115 | if (!strcmp(argv[1], "-DGv")) P->flags |= (DEBUG_GC|DEBUG_VERBOSE); 116 | #endif 117 | } 118 | if (P->mem->old_lo == NULL) { 119 | struct PNMemory *M = P->mem; 120 | int gensz = POTION_BIRTH_SIZE * 2; 121 | void *page = pngc_page_new(&gensz, 0); 122 | if (page == NULL) 123 | potion_fatal("Not enough memory"); 124 | SET_GEN(old, page, gensz); 125 | } 126 | CuString *out = CuStringNew(); 127 | CuSuite *suite = gc_suite(); 128 | CuSuiteRun(suite); 129 | CuSuiteSummary(suite, out); 130 | CuSuiteDetails(suite, out); 131 | printf("%s\n", out->buffer); 132 | count = suite->failCount; 133 | CuSuiteFree(suite); 134 | CuStringFree(out); 135 | return count; 136 | } 137 | -------------------------------------------------------------------------------- /test/api/gc-bench.c: -------------------------------------------------------------------------------- 1 | // 2 | // gc-bench.c 3 | // benchmarking creation and copying of a b-tree 4 | // (see core/gc.c for the lightweight garbage collector, 5 | // based on ideas from Qish by Basile Starynkevitch.) 6 | // 7 | // (c) 2008 why the lucky stiff, the freelance professor 8 | // 9 | #include 10 | #include 11 | #include 12 | #include 13 | #include 14 | #include "potion.h" 15 | #include "internal.h" 16 | #include "gc.h" 17 | #include "khash.h" 18 | #include "table.h" 19 | 20 | Potion *P; 21 | 22 | static const int tree_stretch = 20; 23 | static const int tree_long_lived = 18; 24 | static const int array_size = 2000000; 25 | static const int min_tree = 4; 26 | static const int max_tree = 20; 27 | 28 | static PNType tree_type; 29 | 30 | //#define PN_ALLOC_N(V,T,C) (T *)potion_gc_alloc(P, V, sizeof(T)+C) 31 | //#define ALLOC_NODE() PN_ALLOC_N(tree_type, struct PNObject, 2 * sizeof(PN)) 32 | #define ALLOC_NODE() (PN)potion_gc_alloc(P, tree_type, sizeof(struct PNObject)+ (2*sizeof(PN))) 33 | 34 | unsigned long 35 | current_time(void) 36 | { 37 | struct timeval t; 38 | struct timezone tz; 39 | 40 | if (gettimeofday (&t, &tz) == -1) 41 | return 0; 42 | return (t.tv_sec * 1000 + t.tv_usec / 1000); 43 | } 44 | 45 | // 46 | // TODO: use a b-tree class rather than tuples 47 | // 48 | PN gc_make_tree(int depth, PN PN_left, PN PN_right) { 49 | PN x, l, r; 50 | if (depth <= 0) 51 | return ALLOC_NODE(); 52 | 53 | l = gc_make_tree(depth - 1, PN_left, PN_right); 54 | r = gc_make_tree(depth - 1, PN_left, PN_right); 55 | x = ALLOC_NODE(); 56 | potion_obj_set(P, PN_NIL, x, PN_left, l); 57 | potion_obj_set(P, PN_NIL, x, PN_right, r); 58 | return x; 59 | } 60 | 61 | PN gc_populate_tree(PN node, int depth, PN PN_left, PN PN_right) { 62 | if (depth <= 0) 63 | return; 64 | 65 | depth--; 66 | potion_obj_set(P, PN_NIL, node, PN_left, ALLOC_NODE()); 67 | PN_TOUCH(node); 68 | #ifdef HOLES 69 | n = ALLOC_NODE(); 70 | #endif 71 | potion_obj_set(P, PN_NIL, node, PN_right, ALLOC_NODE()); 72 | PN_TOUCH(node); 73 | #ifdef HOLES 74 | n = ALLOC_NODE(); 75 | #endif 76 | gc_populate_tree(potion_obj_get(P, PN_NIL, node, PN_left), depth, PN_left, PN_right); 77 | gc_populate_tree(potion_obj_get(P, PN_NIL, node, PN_right), depth, PN_left, PN_right); 78 | } 79 | 80 | int gc_tree_depth(PN node, int side, int depth) { 81 | PN n = ((struct PNObject *)node)->ivars[side]; 82 | if (n == PN_NIL) return depth; 83 | return gc_tree_depth(n, side, depth + 1); 84 | } 85 | 86 | int tree_size(int i) { 87 | return ((1 << (i + 1)) - 1); 88 | } 89 | 90 | int main(void) { 91 | POTION_INIT_STACK(sp); 92 | PN klass, ary, temp, long_lived, PN_left, PN_right; 93 | int i, j; 94 | 95 | P = potion_create(sp); 96 | ary = potion_tuple_with_size(P, 2); 97 | PN_TUPLE_AT(ary, 0) = PN_left = potion_str(P, "left"); 98 | PN_TUPLE_AT(ary, 1) = PN_right = potion_str(P, "right"); 99 | klass = potion_class(P, PN_NIL, P->lobby, ary); 100 | tree_type = ((struct PNVtable *)klass)->type; 101 | 102 | printf("Stretching memory with a binary tree of depth %d\n", 103 | tree_stretch); 104 | temp = gc_make_tree(tree_stretch, PN_left, PN_right); 105 | temp = 0; 106 | 107 | printf("Creating a long-lived binary tree of depth %d\n", 108 | tree_long_lived); 109 | long_lived = ALLOC_NODE(); 110 | gc_populate_tree(long_lived, tree_long_lived, PN_left, PN_right); 111 | 112 | printf("Creating a long-lived array of %d doubles\n", 113 | array_size); 114 | ary = potion_tuple_with_size(P, array_size); 115 | for (i = 0; i < array_size / 2; ++i) 116 | PN_TUPLE_AT(ary, i) = PN_NUM(1.0 / i); 117 | 118 | for (i = min_tree; i <= max_tree; i += 2) { 119 | long start, finish; 120 | int iter = 2 * tree_size(tree_stretch) / tree_size(i); 121 | printf ("Creating %d trees of depth %d\n", iter, i); 122 | 123 | start = current_time(); 124 | for (j = 0; j < iter; ++j) { 125 | temp = ALLOC_NODE(); 126 | gc_populate_tree(temp, i, PN_left, PN_right); 127 | } 128 | finish = current_time(); 129 | printf("\tTop down construction took %lu msec\n", 130 | finish - start); 131 | 132 | start = current_time(); 133 | for (j = 0; j < iter; ++j) { 134 | temp = gc_make_tree(i, PN_left, PN_right); 135 | temp = 0; 136 | } 137 | finish = current_time(); 138 | printf("\tBottom up construction took %lu msec\n", 139 | finish - start); 140 | } 141 | 142 | if (long_lived == 0 || PN_TUPLE_AT(ary, 1000) != PN_NUM(1.0 / 1000)) 143 | printf("Wait, problem.\n"); 144 | 145 | printf ("Total %d minor and %d full garbage collections\n" 146 | " (min.birth.size=%dK, max.size=%dK, gc.thresh=%dK)\n", 147 | P->mem->minors, P->mem->majors, 148 | POTION_BIRTH_SIZE >> 10, POTION_MAX_BIRTH_SIZE >> 10, 149 | POTION_GC_THRESHOLD >> 10); 150 | 151 | potion_destroy(P); 152 | return 0; 153 | } 154 | -------------------------------------------------------------------------------- /core/gc.h: -------------------------------------------------------------------------------- 1 | /** \file gc.h 2 | non-API GC internals 3 | 4 | (c) 2008 why the lucky stiff, the freelance professor */ 5 | #ifndef POTION_GC_H 6 | #define POTION_GC_H 7 | 8 | #ifndef POTION_BIRTH_SIZE 9 | #define POTION_BIRTH_SIZE (PN_SIZE_T << 21) 10 | #endif 11 | 12 | #ifndef POTION_MIN_BIRTH_SIZE 13 | #define POTION_MIN_BIRTH_SIZE (PN_SIZE_T << 15) 14 | #endif 15 | 16 | #ifndef POTION_MAX_BIRTH_SIZE 17 | #define POTION_MAX_BIRTH_SIZE (16 * POTION_BIRTH_SIZE) 18 | #endif 19 | 20 | #if POTION_MAX_BIRTH_SIZE < 4 * POTION_BIRTH_SIZE 21 | #error invalid min and max birth sizes 22 | #endif 23 | 24 | #define POTION_GC_THRESHOLD (3 * POTION_BIRTH_SIZE) 25 | #define POTION_GC_PERIOD 256 26 | #define POTION_NB_ROOTS 64 27 | 28 | #define SET_GEN(t, p, s) \ 29 | M->t##_lo = p; \ 30 | M->t##_cur = p + (sizeof(PN) * 2); \ 31 | M->t##_hi = p + (s); \ 32 | p = 0 33 | 34 | #define SET_STOREPTR(n) \ 35 | M->birth_storeptr = (void *)(((void **)M->birth_hi) - (n)) 36 | 37 | #define GC_KEEP(p) \ 38 | *(M->birth_storeptr--) = (void *)p 39 | 40 | #define DEL_BIRTH_REGION() \ 41 | if (M->birth_lo == M && IN_BIRTH_REGION(M->protect)) { \ 42 | void *protend = (void *)PN_ALIGN((_PN)M->protect, POTION_PAGESIZE); \ 43 | pngc_page_delete(protend, (char *)M->birth_hi - (char *)protend); \ 44 | } else { \ 45 | void *protend = (void *)M->birth_lo; \ 46 | pngc_page_delete(protend, (char *)M->birth_hi - (char *)protend); \ 47 | } 48 | 49 | #define IS_GC_PROTECTED(p) \ 50 | ((_PN)(p) >= (_PN)M && (_PN)(p) < (_PN)M->protect) 51 | 52 | #define IN_BIRTH_REGION(p) \ 53 | ((_PN)(p) > (_PN)M->birth_lo && (_PN)(p) < (_PN)M->birth_hi) 54 | 55 | #define IN_OLDER_REGION(p) \ 56 | ((_PN)(p) > (_PN)M->old_lo && (_PN)(p) < (_PN)M->old_hi) 57 | 58 | #define IS_NEW_PTR(p) \ 59 | (PN_IS_PTR(p) && IN_BIRTH_REGION(p) && !IS_GC_PROTECTED(p)) 60 | 61 | #define GC_FORWARD(p, v) do { \ 62 | struct PNFwd *_pnobj = (struct PNFwd *)v; \ 63 | if (_pnobj->fwd == POTION_COPIED) \ 64 | *(p) = _pnobj->ptr; \ 65 | else \ 66 | *(p) = (_PN)potion_gc_copy(P, (struct PNObject *)v); \ 67 | } while(0) 68 | 69 | #define GC_MINOR_UPDATE(p) do { \ 70 | if (PN_IS_PTR(p)) { \ 71 | PN _pnv = potion_fwd((_PN)p); \ 72 | if (IN_BIRTH_REGION(_pnv) && !IS_GC_PROTECTED(_pnv)) \ 73 | { GC_FORWARD((_PN *)&(p), _pnv); } \ 74 | } \ 75 | } while(0) 76 | 77 | #define GC_MAJOR_UPDATE(p) do { \ 78 | if (PN_IS_PTR(p)) { \ 79 | PN _pnv = potion_fwd((_PN)p); \ 80 | if (!IS_GC_PROTECTED(_pnv) && \ 81 | (IN_BIRTH_REGION(_pnv) || IN_OLDER_REGION(_pnv))) \ 82 | {GC_FORWARD((_PN *)&(p), _pnv);} \ 83 | } \ 84 | } while(0) 85 | 86 | #define GC_MINOR_UPDATE_TABLE(name, kh, is_map) do { \ 87 | unsigned k; \ 88 | for (k = kh_begin(kh); k != kh_end(kh); ++k) \ 89 | if (kh_exist(name, kh, k)) { \ 90 | PN v1 = kh_key(name, kh, k); \ 91 | GC_MINOR_UPDATE(v1); \ 92 | kh_key(name, kh, k) = v1; \ 93 | if (is_map) { \ 94 | PN v2 = kh_val(name, kh, k); \ 95 | GC_MINOR_UPDATE(v2); \ 96 | kh_val(name, kh, k) = v2; \ 97 | } \ 98 | } \ 99 | } while (0) 100 | 101 | #define GC_MAJOR_UPDATE_TABLE(name, kh, is_map) do { \ 102 | unsigned k; \ 103 | for (k = kh_begin(kh); k != kh_end(kh); ++k) \ 104 | if (kh_exist(name, kh, k)) { \ 105 | PN v1 = kh_key(name, kh, k); \ 106 | GC_MAJOR_UPDATE(v1); \ 107 | kh_key(name, kh, k) = v1; \ 108 | if (is_map) { \ 109 | PN v2 = kh_val(name, kh, k); \ 110 | GC_MAJOR_UPDATE(v2); \ 111 | kh_val(name, kh, k) = v2; \ 112 | } \ 113 | } \ 114 | } while (0) 115 | 116 | #define GC_MINOR_STRINGS() do { \ 117 | unsigned k; \ 118 | GC_MINOR_UPDATE(P->strings); \ 119 | for (k = kh_begin(P->strings); k != kh_end(P->strings); ++k) \ 120 | if (kh_exist(str, P->strings, k)) { \ 121 | PN v = kh_key(str, P->strings, k); \ 122 | if (IN_BIRTH_REGION(v) && !IS_GC_PROTECTED(v)) { \ 123 | if (((struct PNFwd *)v)->fwd == POTION_COPIED) \ 124 | kh_key(str, P->strings, k) = ((struct PNFwd *)v)->ptr; \ 125 | else \ 126 | kh_del(str, P->strings, k); \ 127 | } \ 128 | } \ 129 | } while (0) 130 | 131 | #define GC_MAJOR_STRINGS() do { \ 132 | unsigned k; \ 133 | GC_MAJOR_UPDATE(P->strings); \ 134 | for (k = kh_begin(P->strings); k != kh_end(P->strings); ++k) \ 135 | if (kh_exist(str, P->strings, k)) { \ 136 | PN v = kh_key(str, P->strings, k); \ 137 | if (!IS_GC_PROTECTED(v) && \ 138 | (IN_BIRTH_REGION(v) || IN_OLDER_REGION(v))) { \ 139 | if (((struct PNFwd *)v)->fwd == POTION_COPIED) \ 140 | kh_key(str, P->strings, k) = ((struct PNFwd *)v)->ptr; \ 141 | else \ 142 | kh_del(str, P->strings, k); \ 143 | } \ 144 | } \ 145 | } while (0) 146 | 147 | static inline int potion_birth_suggest(int need, volatile void *oldlo, volatile void *oldhi) { 148 | int suggest = ((char *)oldhi - (char *)oldlo) / 2; 149 | if (need * 2 > suggest) suggest = need * 2; 150 | if (POTION_MIN_BIRTH_SIZE > suggest) 151 | suggest = POTION_MIN_BIRTH_SIZE; 152 | else if (POTION_BIRTH_SIZE < suggest) 153 | suggest = POTION_BIRTH_SIZE; 154 | return PN_ALIGN(suggest, POTION_MIN_BIRTH_SIZE); 155 | } 156 | 157 | PN_SIZE potion_stack_len(Potion *, _PN **); 158 | PN_SIZE potion_mark_stack(Potion *, int); 159 | void *potion_gc_copy(Potion *, struct PNObject *); 160 | void *pngc_page_new(int *, const char); 161 | void *potion_mark_minor(Potion *, const struct PNObject *); 162 | void *potion_mark_major(Potion *, const struct PNObject *); 163 | void potion_gc_release(Potion *); 164 | 165 | #endif 166 | -------------------------------------------------------------------------------- /core/callcc.c: -------------------------------------------------------------------------------- 1 | ///\file callcc.c 2 | /// creation and calling of continuations, in non-portable asm, x86 only yet 3 | // 4 | // NOTE: these hacks make use of the frame pointer, so they must 5 | // be compiled -fno-omit-frame-pointer! 6 | // 7 | // (c) 2008 why the lucky stiff, the freelance professor 8 | // 9 | #include 10 | #include "potion.h" 11 | #include "internal.h" 12 | 13 | /**\memberof PNCont 14 | "yield" method 15 | \param self PNCont 16 | \see potion_callcc() 17 | \returns does not return, continues execution at the position of the given PNCont */ 18 | PN potion_continuation_yield(Potion *P, PN cl, PN self) { 19 | struct PNCont *cc = (struct PNCont *)self; 20 | PN *start, *end, *sp1 = P->mem->cstack; 21 | #if POTION_STACK_DIR > 0 22 | start = (PN *)cc->stack[0]; 23 | end = (PN *)cc->stack[1]; 24 | #else 25 | start = (PN *)cc->stack[1]; 26 | end = (PN *)cc->stack[0]; 27 | #endif 28 | 29 | if ((PN)sp1 != cc->stack[0]) { 30 | fprintf(stderr, "** TODO: continuations which switch stacks must be rewritten. (%p != %p)\n", 31 | sp1, (void *)(cc->stack[0])); 32 | return PN_NIL; 33 | } 34 | DBG_vt("\nyield: start=%p, end=%p, cc=%p\n", start, end, cc->stack); 35 | 36 | // 37 | // move stack pointer, fill in stack, resume 38 | cc->stack[3] = (PN)cc; 39 | #if POTION_X86 == POTION_JIT_TARGET 40 | #if PN_SIZE_T == 8 41 | __asm__ ("mov 0x8(%2), %%rsp;" 42 | "mov 0x10(%2), %%rbp;" 43 | "mov %2, %%rbx;" 44 | "add $0x48, %2;" 45 | "loop:" 46 | "mov (%2), %%rax;" 47 | "add $0x8, %0;" 48 | "mov %%rax, (%0);" 49 | "add $0x8, %2;" 50 | "cmp %0, %1;" 51 | "jne loop;" 52 | "mov 0x18(%%rbx), %%rax;" 53 | "movq $0x0, 0x18(%%rbx);" 54 | "mov 0x28(%%rbx), %%r12;" 55 | "mov 0x30(%%rbx), %%r13;" 56 | "mov 0x38(%%rbx), %%r14;" 57 | "mov 0x40(%%rbx), %%r15;" 58 | "mov 0x20(%%rbx), %%rbx;" 59 | "leave; ret" 60 | :/* no output */ 61 | :"r"(start), "r"(end), "r"(cc->stack) 62 | :"%rax", "%rsp", "%rbx" 63 | ); 64 | #else 65 | __asm__ ("mov 0x4(%2), %%esp;" 66 | "mov 0x8(%2), %%ebp;" 67 | "mov %2, %%esi;" 68 | "add $0x1c, %2;" 69 | "loop:" 70 | "mov (%2), %%eax;" 71 | "add $0x4, %0;" 72 | "mov %%eax, (%0);" 73 | "add $0x4, %2;" 74 | "cmp %0, %1;" 75 | "jne loop;" 76 | "mov 0xc(%%esi), %%eax;" 77 | "mov 0x14(%%esi), %%edi;" 78 | "mov 0x18(%%esi), %%ebx;" 79 | "mov 0x10(%%esi), %%esi;" 80 | "leave; ret" 81 | :/* no output */ 82 | :"r"(start), "r"(end), "r"(cc->stack) 83 | :"%eax", "%esp", /*"%ebp",*/ "%esi" 84 | ); 85 | //DBG_vt("yield => start=%p, end=%p, cc=%p\n", start, end, cc->stack); 86 | #endif 87 | #else 88 | fprintf(stderr, "** TODO: callcc/yield does not work outside of X86 yet.\n"); 89 | #endif 90 | #ifdef DEBUG 91 | if (!P->strings || !P->lobby || !P->mem) 92 | potion_fatal("fatal: yield stack underflow\n"); 93 | #endif 94 | return self; 95 | } 96 | 97 | /**\memberof PNVtable 98 | global "here" method 99 | \see potion_continuation_yield() 100 | \returns a PNCont continuation object which can be yield'ed to later */ 101 | ATTRIBUTE_NO_ADDRESS_SAFETY_ANALYSIS 102 | PN potion_callcc(Potion *P, PN cl, PN self) { 103 | struct PNCont *cc; 104 | long n; 105 | PN *start, *sp1 = P->mem->cstack, *sp2, *sp3; 106 | #if defined(DEBUG) && (PN_SIZE_T == 8) 107 | if ((_PN)sp1 & 0xF) { 108 | fprintf(stderr,"P->mem->cstack=0x%lx ", (_PN)sp1); 109 | potion_fatal("stack not 16byte aligned"); 110 | } 111 | #endif 112 | POTION_ESP(&sp2); // usually P 113 | POTION_EBP(&sp3); 114 | #if POTION_STACK_DIR > 0 115 | n = sp2 - sp1; 116 | start = sp1; 117 | #else 118 | n = sp1 - sp2 + 1; 119 | start = sp2; 120 | #endif 121 | 122 | if (n < 0) { 123 | DBG_vt("\ncallcc: n=%ld, start=%p, end=%p, cc=%p\n", n, start, sp2, sp1); 124 | potion_fatal("invalid stack direction"); 125 | return 0; 126 | } 127 | cc = PN_ALLOC_N(PN_TCONT, struct PNCont, sizeof(PN) * (n + 3 + PN_SAVED_REGS)); 128 | cc->len = n + 3; 129 | cc->stack[0] = (PN)sp1; 130 | cc->stack[1] = (PN)sp2; 131 | cc->stack[2] = (PN)sp3; 132 | cc->stack[3] = PN_NIL; 133 | DBG_vt("\ncallcc: start=%p, end=%p, cc=%p\n", start, sp2, cc->stack); 134 | #if POTION_X86 == POTION_JIT_TARGET 135 | #if PN_SIZE_T == 8 136 | __asm__ ("mov %%rbx, 0x20(%0);" 137 | "mov %%r12, 0x28(%0);" 138 | "mov %%r13, 0x30(%0);" 139 | "mov %%r14, 0x38(%0);" 140 | "mov %%r15, 0x40(%0);"::"r"(cc->stack)); 141 | #else 142 | __asm__ ("mov %%esi, 0x10(%0);" 143 | "mov %%edi, 0x14(%0);" 144 | "mov %%ebx, 0x18(%0)"::"r"(cc->stack)); 145 | #endif 146 | #endif 147 | 148 | // avoid wrong asan stack underflow, caught in memcpy 149 | #if defined(__clang__) && defined(__SANITIZE_ADDRESS__) 150 | { 151 | PN *s = start + 1; 152 | PN *d = cc->stack + 4 + PN_SAVED_REGS; 153 | for (int i=0; i < n - 1; i++) { 154 | *d++ = *s++; 155 | } 156 | } 157 | #else 158 | PN_MEMCPY_N((char *)(cc->stack + 4 + PN_SAVED_REGS), start + 1, PN, n - 1); 159 | #endif 160 | // stack-buffer-underflow sanity check, should not overwrite P 161 | #ifdef DEBUG 162 | if (!P->strings || !P->lobby || !P->mem) 163 | potion_fatal("fatal: callcc stack underflow\n"); 164 | #endif 165 | return (PN)cc; 166 | } 167 | 168 | // callcc is the "here" method of lobby 169 | void potion_cont_init(Potion *P) { 170 | PN cnt_vt = PN_VTABLE(PN_TCONT); 171 | potion_type_call_is(cnt_vt, PN_FUNC(potion_continuation_yield, 0)); 172 | } 173 | -------------------------------------------------------------------------------- /core/ast.c: -------------------------------------------------------------------------------- 1 | ///\file ast.c 2 | /// the ast for Potion code in-memory implements PNSource 3 | // 4 | // (c) 2008 why the lucky stiff, the freelance professor 5 | // 6 | #include 7 | #include 8 | #include "potion.h" 9 | #include "internal.h" 10 | #include "ast.h" 11 | 12 | ///\see potion.h: enum PN_AST 13 | const char *potion_ast_names[] = { 14 | "code", "value", "assign", "not", "or", "and", "cmp", "eq", "neq", 15 | "gt", "gte", "lt", "lte", "pipe", "caret", "amp", "wavy", "bitl", 16 | "bitr", "plus", "minus", "inc", "times", "div", "rem", "pow", 17 | "msg", "path", "query", "pathq", "expr", "list", "block", "lick", 18 | "proto", "debug" 19 | }; 20 | 21 | const int potion_ast_sizes[] = { 22 | 1, 3, 2, 1, 2, 2, 2, 2, 2, 23 | 2, 2, 2, 2, 2, 2, 2, 1, 2, 24 | 2, 2, 2, 2, 2, 2, 2, 2, 25 | 3, 1, 1, 1, 1, 1, 1, 3, 26 | 2, 3 27 | }; 28 | 29 | /// PNSource constructor 30 | ///\param p AST type 31 | ///\param a,b,c AST operands 32 | ///\param lineno linenumber in src file 33 | ///\param line associated line PNString in src file 34 | ///\returns a new AST node with up to three operands 35 | PN potion_source(Potion *P, u8 p, PN a, PN b, PN c, int lineno, PN line) { 36 | int size = potion_ast_sizes[p]; 37 | // TODO: potion_ast_sizes[p] * sizeof(PN) (then fix gc_copy) 38 | vPN(Source) t = PN_ALLOC(PN_TSOURCE, struct PNSource); 39 | t->part = (enum PN_AST)p; 40 | t->loc.fileno = P->fileno; // only advanced by load/require 41 | t->loc.lineno = lineno; 42 | t->line = line; 43 | #if 1 44 | switch (size) { 45 | case 3: t->a[2] = PN_SRC(c); 46 | case 2: t->a[1] = PN_SRC(b); 47 | case 1: t->a[0] = PN_SRC(a); break; 48 | default: potion_fatal("invalid AST type"); 49 | } 50 | #else 51 | switch (size) { 52 | case 3: t->a[0] = PN_SRC(a); t->a[1] = PN_SRC(b); t->a[2] = PN_SRC(c); break; 53 | case 2: t->a[0] = PN_SRC(a); t->a[1] = PN_SRC(b); t->a[2] = 0; break; 54 | case 1: t->a[0] = PN_SRC(a); t->a[1] = t->a[2] = 0; break; 55 | default: potion_fatal("invalid AST type"); 56 | } 57 | #endif 58 | return (PN)t; 59 | } 60 | 61 | ///\memberof PNSource 62 | /// "size" method 63 | ///\returns number of ast trees: 1,2 or 3 64 | static PN potion_source_size(Potion *P, PN cl, PN self) { 65 | vPN(Source) t = (struct PNSource *)potion_fwd(self); 66 | return PN_NUM(potion_ast_sizes[t->part]); 67 | } 68 | 69 | ///\memberof PNSource 70 | /// "name" method 71 | static PN potion_source_name(Potion *P, PN cl, PN self) { 72 | vPN(Source) t = (struct PNSource *)potion_fwd(self); 73 | return potion_str(P, potion_ast_names[t->part]); 74 | } 75 | 76 | ///\memberof PNSource 77 | /// "file" method 78 | ///\returns filename of associated AST 79 | static PN potion_source_file(Potion *P, PN cl, PN self) { 80 | vPN(Source) t = (struct PNSource *)potion_fwd(self); 81 | return PN_TUPLE_AT(pn_filenames, t->loc.fileno); 82 | } 83 | 84 | ///\memberof PNSource 85 | /// "lineno" method 86 | ///\returns line number of associated AST 87 | static PN potion_source_lineno(Potion *P, PN cl, PN self) { 88 | vPN(Source) t = (struct PNSource *)potion_fwd(self); 89 | return PN_NUM(t->loc.lineno); 90 | } 91 | 92 | ///\memberof PNSource 93 | /// "line" method 94 | ///\returns line string of associated AST 95 | static PN potion_source_line(Potion *P, PN cl, PN self) { 96 | vPN(Source) t = (struct PNSource *)potion_fwd(self); 97 | return t->line; 98 | } 99 | 100 | ///\memberof PNSource 101 | /// "string" method of the AST 102 | /// Note: Does not output the AST type, filename nor lineno 103 | static PN potion_source_string(Potion *P, PN cl, PN self) { 104 | int i, n, cut = 0; 105 | vPN(Source) t = (struct PNSource *)potion_fwd(self); 106 | PN out = potion_byte_str(P, potion_ast_names[t->part]); 107 | int lineno = t->loc.lineno; 108 | n = potion_ast_sizes[t->part]; 109 | for (i = 0; i < n; i++) { 110 | pn_printf(P, out, " "); 111 | if (i == 0 && n > 1) pn_printf(P, out, "("); 112 | else if (i > 0) { 113 | if (!t->a[i]) { // omit subsequent nils 114 | if (!cut) cut = PN_STR_LEN(out); 115 | } 116 | else cut = 0; 117 | } 118 | if (PN_IS_STR(t->a[i])) { 119 | pn_printf(P, out, "\""); 120 | potion_bytes_obj_string(P, out, (PN)t->a[i]); 121 | pn_printf(P, out, "\""); 122 | } else { 123 | potion_bytes_obj_string(P, out, (PN)t->a[i]); 124 | } 125 | if ((PN_TYPE(t->a[i]) == PN_TSOURCE) && (t->a[i]->loc.lineno > lineno)) { 126 | pn_printf(P, out, "\n"); 127 | lineno = t->a[i]->loc.lineno; 128 | } 129 | if (i == n - 1 && n > 1) { 130 | if (cut > 0) { 131 | vPN(Bytes) b = (struct PNBytes *)potion_fwd(out); 132 | //DBG_vt("cut at %d, len=%d: \"%s\"\n", cut, b->len, b->chars); 133 | if (cut < b->len) { 134 | b->len = cut - 1; 135 | if (b->chars[cut-1] == ' ') 136 | b->chars[cut-1] = '\0'; 137 | else 138 | b->chars[cut] = '\0'; 139 | } 140 | } 141 | pn_printf(P, out, ")"); 142 | } 143 | } 144 | return PN_STR_B(out); 145 | } 146 | 147 | ///\memberof PNSource 148 | /// \returns file.c:lineno 149 | static PN potion_source_loc(Potion *P, PN cl, PN self) { 150 | PN out = potion_byte_str(P, ""); 151 | pn_printf(P, out, "%s:%ld", 152 | PN_STR_PTR(potion_source_file(P, cl, self)), 153 | PN_INT(potion_source_lineno(P, cl, self))); 154 | return PN_STR_B(out); 155 | } 156 | 157 | void potion_source_init(Potion *P) { 158 | PN src_vt = PN_VTABLE(PN_TSOURCE); 159 | potion_method(src_vt, "name", potion_source_name, 0); 160 | potion_method(src_vt, "string", potion_source_string, 0); 161 | potion_method(src_vt, "size", potion_source_size, 0); 162 | potion_method(src_vt, "file", potion_source_file, 0); 163 | potion_method(src_vt, "lineno", potion_source_lineno, 0); 164 | potion_method(src_vt, "line", potion_source_line, 0); 165 | potion_method(src_vt, "loc", potion_source_loc, 0); 166 | } 167 | -------------------------------------------------------------------------------- /dist.mak: -------------------------------------------------------------------------------- 1 | # -*- makefile -*- 2 | include config.inc 3 | 4 | SUDO = sudo 5 | GREG = bin/greg${EXE} 6 | 7 | ifeq (${PREFIX},) 8 | $(error need to make config first) 9 | endif 10 | ifeq (${DLL},) 11 | $(error need to make config first) 12 | endif 13 | 14 | VERSION = $(shell ./tools/config.sh "${CC}" version) 15 | PLATFORM = $(shell ./tools/config.sh "${CC}" target) 16 | RELEASE ?= ${VERSION}.${REVISION} 17 | PKG = potion-${RELEASE} 18 | PKGBIN = ${PKG}-${PLATFORM} 19 | PKG_DESC = "potion language" 20 | ifeq (${WIN32},1) 21 | BINDIST = pkg/${PKGBIN}.zip 22 | else 23 | BINDIST = pkg/${PKGBIN}.tar.gz pkg/${PKGBIN}-devel.tar.gz 24 | endif 25 | 26 | dist: bin-dist src-dist 27 | 28 | release: dist 29 | 30 | # sudo gem install fpm 31 | # pkgin is for BSD, with pkg_create 32 | # TODO: need a simple one-line windows cmd-line installer from the zip 33 | 34 | define EXPAND_DEPLOY 35 | ifneq ($$(WIN32),1) 36 | deploy: release 37 | rm -rf dist 38 | mkdir dist 39 | tar xfz pkg/${PKGBIN}.tar.gz -C dist/ 40 | tar xfz pkg/${PKGBIN}-devel.tar.gz -C dist/ 41 | ifeq ($$(DLL),.so) 42 | fpm -s dir -t deb -C dist -p pkg --name potion --version $(VERSION) --description $(PKG_DESC) 43 | fpm -s dir -t rpm -C dist -p pkg --name potion --version $(VERSION) --description $(PKG_DESC) 44 | -fpm -s dir -t pkgin -C dist -p pkg --name potion --version $(VERSION) --description $(PKG_DESC) 45 | endif 46 | ifeq ($$(DLL),.dylib) 47 | fpm -s dir -t osxpkg -C dist -p pkg --name potion --version $(VERSION) --description $(PKG_DESC) 48 | endif 49 | rm -rf dist 50 | endif 51 | endef 52 | 53 | $(eval $(call EXPAND_DEPLOY)) 54 | 55 | install: bin-dist 56 | ${SUDO} tar xfz pkg/${PKGBIN}.tar.gz -C $(PREFIX)/ 57 | 58 | bin-dist: ${BINDIST} 59 | 60 | pkg/${PKGBIN}.tar.gz: core/config.h core/version.h bin/potion${EXE} \ 61 | lib/libpotion${DLL} lib/potion/readline${LOADEXT} 62 | rm -rf dist 63 | mkdir -p dist dist/bin dist/include/potion dist/lib/potion \ 64 | dist/share/potion/doc dist/share/potion/example 65 | cp bin/potion${EXE} dist/bin/ 66 | cp lib/libpotion${DLL} dist/lib/ 67 | cp -r lib/potion dist/lib/ 68 | if [ ${WIN32} = 1 ]; then mv dist/lib/*.dll dist/bin/; fi 69 | -if [ $(APPLE) = 1 ]; then rsync -a lib/libuv*.dylib dist/lib/; fi 70 | cp core/potion.h dist/include/potion/ 71 | cp core/config.h dist/include/potion/ 72 | -cp doc/*.html doc/*.png dist/share/potion/doc/ 73 | -cp doc/core-files.txt dist/share/potion/doc/ 74 | -cp README.md COPYING LICENSE ChangeLog dist/share/potion/doc/ 75 | cp example/* dist/share/potion/example/ 76 | -mkdir -p pkg 77 | (cd dist && tar czf ../pkg/${PKGBIN}.tar.gz * && cd ..) 78 | rm -rf dist 79 | 80 | pkg/${PKGBIN}.zip: core/config.h core/version.h core/syntax.c bin/potion${EXE} \ 81 | lib/libpotion${DLL} lib/libuv.dll.a lib/potion/readline${LOADEXT} 82 | rm -rf dist 83 | mkdir -p dist dist/lib dist/include/potion dist/lib/potion dist/doc dist/example dist/test/ 84 | cp bin/potion${EXE} dist/ 85 | cp ${GREG} dist/ 86 | cp lib/libpotion${DLL} dist/ 87 | cp lib/libuv-*.dll dist/ 88 | cp lib/libuv.dll.a dist/lib 89 | cp -r lib/potion/* dist/lib/potion/ 90 | cp core/potion.h dist/include/potion/ 91 | cp core/config.h dist/include/potion/ 92 | -cp doc/*.html doc/*.png dist/doc/ 93 | if [ -f doc/html/potion.chm ]; then \ 94 | cp doc/html/potion.chm dist/doc/potion.chm; \ 95 | else cp -r doc/html dist/doc/; \ 96 | fi 97 | -cp -r doc/ref dist/doc/ 98 | -cp doc/core-files.txt dist/doc/ 99 | -cp README.md COPYING LICENSE ChangeLog dist/doc/ 100 | cp example/* dist/example/ 101 | cp -r test/* dist/test/ 102 | -mkdir -p pkg 103 | (cd dist && zip -q ../pkg/${PKGBIN}.zip -rm * && cd ..) 104 | rm -rf dist 105 | 106 | pkg/${PKGBIN}-devel.tar.gz: ${GREG} bin/potion-s${EXE} lib/libpotion.a 107 | ${MAKE} doxygen GTAGS 108 | rm -rf dist 109 | mkdir -p dist dist/bin dist/include/potion dist/lib/potion \ 110 | dist/share/potion/doc/ref dist/share/potion/test 111 | cp ${GREG} dist/bin/ 112 | cp bin/potion-s${EXE} dist/bin/ 113 | cp lib/libpotion.a dist/lib/ 114 | cp core/*.h dist/include/potion/ 115 | rm dist/include/potion/potion.h dist/include/potion/config.h 116 | -cp -r doc/*.textile doc/html dist/share/potion/doc/ 117 | -cp -r doc/latex I*.md doc/I*.md dist/share/potion/doc/ 118 | -cp -r doc/ref/* dist/share/potion/doc/ref/ 119 | cp -r test/* dist/share/potion/test/ 120 | -mkdir -p pkg 121 | (cd dist && tar czf ../pkg/${PKGBIN}-devel.tar.gz * && cd ..) 122 | rm -rf dist 123 | 124 | src-dist: pkg/${PKG}-src.tar.gz 125 | 126 | pkg/${PKG}-src.tar.gz: tarball 127 | 128 | #TODO: you should be able to build without git 129 | tarball: core/version.h core/syntax.c 130 | -mkdir -p pkg 131 | rm -rf ${PKG} 132 | git checkout-index --prefix=${PKG}/ -a 133 | rm -f ${PKG}/.gitignore 134 | +${MAKE} MANIFEST 135 | cp MANIFEST ${PKG}/ 136 | cp core/version.h ${PKG}/core/ 137 | cp core/syntax.c ${PKG}/core/ 138 | tar czf pkg/${PKG}-src.tar.gz ${PKG} 139 | rm -rf ${PKG} 140 | 141 | GTAGS: ${SRC} core/*.h 142 | rm -rf ${PKG} doc/ref 143 | git checkout-index --prefix=${PKG}/ -a 144 | -cp core/version.h ${PKG}/core/ 145 | cd ${PKG} && \ 146 | mv tools/greg.c tools/greg-c.tmp && \ 147 | gtags && htags && \ 148 | sed -e's,background-color: #f5f5dc,background-color: #ffffff,' < HTML/style.css > HTML/style.new && \ 149 | mv HTML/style.new HTML/style.css && \ 150 | mv tools/greg-c.tmp tools/greg.c && \ 151 | cd .. && \ 152 | mv ${PKG}/HTML ${PKG}/ref && \ 153 | mv ${PKG}/ref doc/ 154 | rm -rf ${PKG} 155 | 156 | .PHONY: dist release deploy install tarball src-dist bin-dist 157 | -------------------------------------------------------------------------------- /lib/database.c: -------------------------------------------------------------------------------- 1 | /** \file lib/database.c 2 | sqlite3 binding 3 | \class Database 4 | 5 | provided by Peter Arthur 6 | */ 7 | #include "potion.h" 8 | #include 9 | #include 10 | 11 | #define PN_ALLOC(V,T) (T * volatile)potion_gc_alloc(P, V, sizeof(T)) 12 | 13 | #define PN_GET_DATABASE(t) ((struct PNDatabase *)potion_fwd((PN)t)) 14 | PNType PN_TDATABASE; 15 | 16 | struct PNDatabase { 17 | PN_OBJECT_HEADER; 18 | sqlite3 *db; 19 | }; 20 | 21 | struct PNCallback { 22 | PN_OBJECT_HEADER; 23 | PN_SIZE siz; 24 | Potion *P; 25 | PN cb; 26 | }; 27 | 28 | const int CallbackSize = sizeof(struct PNCallback) - sizeof(struct PNData); 29 | 30 | PN potion_sqlite_open(Potion *P, PN cl, PN self, PN path); 31 | PN potion_callback(Potion *P, PN closure); 32 | 33 | static int 34 | potion_database_callback(void *callback, int argc, char **argv, char **azColName) { 35 | struct PNCallback * cbp = (struct PNCallback *)callback; 36 | 37 | if (cbp != NULL) { 38 | vPN(Closure) cb = PN_IS_CLOSURE(cbp->cb) ? PN_CLOSURE(cbp->cb) : NULL; 39 | 40 | if (cb) { 41 | Potion *P = cbp->P; 42 | PN table = potion_table_empty(P); 43 | int i; 44 | for (i = 0; i < argc; i++) { 45 | potion_table_put(P, PN_NIL, table, PN_STR(azColName[i]), 46 | argv[i] ? PN_STR(argv[i]) : PN_NIL); 47 | } 48 | // Now call the callback with the table 49 | cb->method(P, (PN)cb, (PN)cb, (PN)table); 50 | } 51 | } 52 | return 0; 53 | } 54 | 55 | PN potion_sqlite_new(Potion *P, PN cl, PN ign, PN path) { 56 | struct PNDatabase * volatile self = PN_ALLOC(PN_TDATABASE, struct PNDatabase); 57 | self->db = NULL; 58 | PN_TOUCH(self); 59 | return potion_sqlite_open(P, cl, (PN)self, path); 60 | } 61 | 62 | ///\memberof Database 63 | /// Executes the query statement and optionally calls the callback with the result. 64 | ///\param query PNString a SQL statement 65 | ///\param callback optional PNClosure with a PNTable row argument 66 | ///\return self or nil or an error 67 | PN potion_sqlite_exec(Potion *P, PN cl, PN self, PN query, PN callback) { 68 | //TODO: Proper error checking 69 | if (!PN_IS_STR(query)) { 70 | return PN_NIL; 71 | } 72 | char *zErrMsg = 0; 73 | int rc; 74 | struct PNDatabase *db = (struct PNDatabase *)self; 75 | struct PNCallback *cb = (struct PNCallback*)potion_callback(P, callback); 76 | if (db->db == NULL) { 77 | //FIXME: Return a proper error 78 | return potion_io_error(P, "exec"); 79 | } 80 | rc = sqlite3_exec(db->db, PN_STR_PTR(query), 81 | potion_database_callback, cb, &zErrMsg); 82 | if (rc != SQLITE_OK) { 83 | // Convert to potion string and return it as an error 84 | fprintf(stderr, "SQL error: %s\n", zErrMsg); 85 | PN e = potion_io_error(P, zErrMsg); 86 | sqlite3_free(zErrMsg); 87 | return e; 88 | } 89 | return self; 90 | } 91 | 92 | ///\memberof Database 93 | ///\param query PNString a select statement 94 | ///\return a tuple of all tables (rows) 95 | PN potion_sqlite_gettable(Potion *P, PN cl, PN self, PN query) { 96 | //TODO: Proper error checking 97 | if (!PN_IS_STR(query)) { 98 | return PN_NIL; 99 | } 100 | char *q = PN_STR_PTR(query); 101 | struct PNDatabase *db = PN_GET_DATABASE(self); 102 | if (!db->db) { 103 | return PN_NIL; 104 | } 105 | char **pazResult; /* Results of the query */ 106 | int pnRow; /* Number of result rows written here */ 107 | int pnColumn; /* Number of result columns written here */ 108 | char *pzErrmsg; /* Error msg written here */ 109 | int rc = sqlite3_get_table(db->db, q, &pazResult, 110 | &pnRow, &pnColumn, &pzErrmsg); 111 | // Check for error 112 | if (rc != SQLITE_OK) { 113 | // Convert to potion string and return it as an error 114 | fprintf(stderr, "SQL error: %s\n", pzErrmsg); 115 | PN e = potion_io_error(P, pzErrmsg); 116 | sqlite3_free(pzErrmsg); 117 | return e; 118 | } 119 | // Process the table 120 | int i, j; 121 | PN tuple = potion_tuple_empty(P); 122 | // Loop over each row 123 | for (i = 1; i <= pnRow; i++) { 124 | PN table = potion_table_empty(P); 125 | for (j = 0; j < pnColumn; j++) { 126 | char *value = pazResult[i*pnColumn + j]; 127 | potion_table_put(P, PN_NIL, table, PN_STR(pazResult[j]), 128 | value ? PN_STR(value) : PN_NIL); 129 | } 130 | PN_PUSH(tuple, table); 131 | } 132 | sqlite3_free_table(pazResult); 133 | return tuple; 134 | } 135 | 136 | PN potion_sqlite_close(Potion *P, PN cl, PN self) { 137 | struct PNDatabase *db = (struct PNDatabase *)self; 138 | if (db->db) { 139 | sqlite3_close(db->db); 140 | db->db = NULL; 141 | } 142 | return self; 143 | } 144 | 145 | PN potion_sqlite_open(Potion *P, PN cl, PN self, PN path) { 146 | struct PNDatabase *db = (struct PNDatabase *)self; 147 | //TODO: Proper error checking 148 | if (!PN_IS_STR(path)) { 149 | return PN_NIL; 150 | } 151 | if (db->db) { 152 | potion_sqlite_close(P, cl, self); 153 | } 154 | sqlite3 *sdb; 155 | int rc = sqlite3_open(PN_STR_PTR(path), &sdb); 156 | if (rc) 157 | return potion_io_error(P, "open"); 158 | db->db = sdb; 159 | return self; 160 | } 161 | 162 | PN potion_sqlite_isopen(Potion *P, PN cl, PN self) { 163 | struct PNDatabase *db = (struct PNDatabase *)self; 164 | return db->db ? PN_TRUE : PN_FALSE; 165 | } 166 | 167 | PN potion_callback(Potion *P, PN closure) { 168 | struct PNCallback *cb = (struct PNCallback *)potion_data_alloc(P, CallbackSize); 169 | cb->siz = CallbackSize; // To help out GC 170 | cb->P = P; 171 | cb->cb = closure; 172 | return (PN)cb; 173 | } 174 | 175 | void Potion_Init_database(Potion *P) { 176 | PN db_vt = potion_class(P, 0, 0, 0); 177 | PN_TDATABASE = potion_class_type(P, db_vt); 178 | potion_define_global(P, PN_STR("Database"), db_vt); 179 | 180 | potion_type_constructor_is(db_vt, PN_FUNC(potion_sqlite_new, "path=S")); 181 | potion_method(db_vt, "exec", potion_sqlite_exec, "query=S|callback=o"); 182 | potion_method(db_vt, "gettable", potion_sqlite_gettable, "query=S"); 183 | potion_method(db_vt, "close", potion_sqlite_close, 0); 184 | potion_method(db_vt, "open", potion_sqlite_open, "path=S"); 185 | potion_method(db_vt, "open?", potion_sqlite_isopen, 0); 186 | } 187 | 188 | /* 189 | load "database" 190 | 191 | db = Database("database.db") 192 | db exec "CREATE TABLE t (id INT, name TEXT)" 193 | db exec "INSERT INTO t (id,name) VALUES (1,'New name')" 194 | db close 195 | db open? say 196 | db open("database.db") 197 | db open? say 198 | db exec "INSERT INTO t (id,name) VALUES (2,'Old name')" 199 | db exec "SELECT * FROM t" (row): row say. 200 | db gettable "SELECT * FROM t" say 201 | db open? say 202 | db close 203 | 204 | */ 205 | -------------------------------------------------------------------------------- /core/mt19937ar.c: -------------------------------------------------------------------------------- 1 | /**\file mt19937ar.c 2 | random numbers (mersenne twister). As Lobby (global long) or PNInteger (0-1.0) 3 | 4 | A C-program for MT19937, with initialization improved 2002/2/10. 5 | Coded by Takuji Nishimura and Makoto Matsumoto. 6 | This is a faster version by taking Shawn Cokus's optimization, 7 | Matthe Bellew's simplification, Isaku Wada's real version. 8 | 9 | Before using, initialize the state by using init_genrand(seed) 10 | or init_by_array(init_key, key_length). 11 | 12 | Copyright (C) 1997 - 2002, Makoto Matsumoto and Takuji Nishimura, 13 | All rights reserved. 14 | 15 | Redistribution and use in source and binary forms, with or without 16 | modification, are permitted provided that the following conditions 17 | are met: 18 | 19 | 1. Redistributions of source code must retain the above copyright 20 | notice, this list of conditions and the following disclaimer. 21 | 22 | 2. Redistributions in binary form must reproduce the above copyright 23 | notice, this list of conditions and the following disclaimer in the 24 | documentation and/or other materials provided with the distribution. 25 | 26 | 3. The names of its contributors may not be used to endorse or promote 27 | products derived from this software without specific prior written 28 | permission. 29 | 30 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 31 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 32 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 33 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR 34 | CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 35 | EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, 36 | PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 37 | PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 38 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 39 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 40 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 41 | 42 | 43 | Any feedback is very welcome. 44 | http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/emt.html 45 | email: m-mat @ math.sci.hiroshima-u.ac.jp (remove space) 46 | */ 47 | 48 | #include 49 | #include "potion.h" 50 | 51 | /* Period parameters */ 52 | #define N 624 53 | #define M 397 54 | #define MATRIX_A 0x9908b0dfUL /* constant vector a */ 55 | #define UMASK 0x80000000UL /* most significant w-r bits */ 56 | #define LMASK 0x7fffffffUL /* least significant r bits */ 57 | #define MIXBITS(u,v) ( ((u) & UMASK) | ((v) & LMASK) ) 58 | #define TWIST(u,v) ((MIXBITS(u,v) >> 1) ^ ((v)&1UL ? MATRIX_A : 0UL)) 59 | 60 | static unsigned long state[N]; /* the array for the state vector */ 61 | static int left = 1; 62 | static int initf = 0; 63 | static unsigned long *next; 64 | 65 | /* initializes state[N] with a seed */ 66 | void init_genrand(unsigned long s) { 67 | int j; 68 | state[0]= s & 0xffffffffUL; 69 | for (j=1; j> 30)) + j); 71 | /* See Knuth TAOCP Vol2. 3rd Ed. P.106 for multiplier. */ 72 | /* In the previous versions, MSBs of the seed affect */ 73 | /* only MSBs of the array state[]. */ 74 | /* 2002/01/09 modified by Makoto Matsumoto */ 75 | state[j] &= 0xffffffffUL; /* for >32 bit machines */ 76 | } 77 | left = 1; initf = 1; 78 | } 79 | 80 | /* initialize by an array with array-length */ 81 | /* init_key is the array for initializing keys */ 82 | /* key_length is its length */ 83 | /* slight change for C++, 2004/2/26 */ 84 | void init_by_array(unsigned long init_key[], int key_length) { 85 | int i, j, k; 86 | init_genrand(19650218UL); 87 | i=1; j=0; 88 | k = (N>key_length ? N : key_length); 89 | for (; k; k--) { 90 | state[i] = (state[i] ^ ((state[i-1] ^ (state[i-1] >> 30)) * 1664525UL)) 91 | + init_key[j] + j; /* non linear */ 92 | state[i] &= 0xffffffffUL; /* for WORDSIZE > 32 machines */ 93 | i++; j++; 94 | if (i>=N) { state[0] = state[N-1]; i=1; } 95 | if (j>=key_length) j=0; 96 | } 97 | for (k=N-1; k; k--) { 98 | state[i] = (state[i] ^ ((state[i-1] ^ (state[i-1] >> 30)) * 1566083941UL)) 99 | - i; /* non linear */ 100 | state[i] &= 0xffffffffUL; /* for WORDSIZE > 32 machines */ 101 | i++; 102 | if (i>=N) { state[0] = state[N-1]; i=1; } 103 | } 104 | 105 | state[0] = 0x80000000UL; /* MSB is 1; assuring non-zero initial array */ 106 | left = 1; initf = 1; 107 | } 108 | 109 | static void next_state(void) { 110 | unsigned long *p=state; 111 | int j; 112 | 113 | /* if init_genrand() has not been called, */ 114 | /* a default initial seed is used */ 115 | if (initf==0) init_genrand(5489UL); 116 | 117 | left = N; 118 | next = state; 119 | 120 | for (j=N-M+1; --j; p++) { 121 | /*@ assert Value: mem_access: \valid_read(p+1); */ 122 | /*@ assert Value: mem_access: \valid_read(p+397); */ 123 | *p = p[M] ^ TWIST(p[0], p[1]); 124 | } 125 | 126 | for (j=M; --j; p++) { 127 | /*@ assert Value: mem_access: \valid_read(p+1); */ 128 | /*@ assert Value: mem_access: \valid_read(p+(int)(397-624)); */ 129 | *p = p[M-N] ^ TWIST(p[0], p[1]); 130 | } 131 | 132 | /*@ assert Value: mem_access: \valid(p); */ 133 | /*@ assert Value: mem_access: \valid_read(p+(int)(397-624)); */ 134 | *p = p[M-N] ^ TWIST(p[0], state[0]); 135 | } 136 | 137 | /** generates a random number on [0,0xffffffff]-interval */ 138 | unsigned long potion_rand_int(void) { 139 | unsigned long y; 140 | 141 | if (--left == 0) next_state(); 142 | y = *next++; 143 | 144 | /* Tempering */ 145 | y ^= (y >> 11); 146 | y ^= (y << 7) & 0x9d2c5680UL; 147 | y ^= (y << 15) & 0xefc60000UL; 148 | y ^= (y >> 18); 149 | 150 | return y; 151 | } 152 | 153 | /** generates a random number on [0,1) with 53-bit resolution*/ 154 | double potion_rand_double(void) { 155 | unsigned long a=potion_rand_int()>>5, b=potion_rand_int()>>6; 156 | return(a*67108864.0+b)*(1.0/9007199254740992.0); 157 | } 158 | /**\memberof Lobby 159 | "srand" initialize random seed 160 | \param seed PNInteger 161 | \return Lobby (usually unused) 162 | \sa potion_rand. */ 163 | PN potion_srand(Potion *P, PN cl, PN self, PN seed) { 164 | init_genrand(PN_INT(seed)); 165 | return self; 166 | } 167 | 168 | /**\memberof Lobby 169 | "rand" generate random ulong number 170 | \code rand #=> xxxxxx \endcode 171 | \return PNDouble in [0,0xffffffff]-interval 172 | \sa potion_num_rand for double, potion_srand. */ 173 | PN potion_rand(Potion *P, PN cl, PN self) { 174 | return PN_NUM(potion_rand_int()); 175 | } 176 | 177 | /**\memberof PNInteger 178 | "rand" generate random float number 179 | \code 1 rand #=> 0.xxxxxx \endcode 180 | \return PNDouble in [0.0,0.1]-interval 181 | \sa potion_rand for long, potion_srand. */ 182 | PN potion_num_rand(Potion *P, PN cl, PN self) { 183 | return PN_NUM(potion_rand_double()); 184 | } 185 | -------------------------------------------------------------------------------- /core/file.c: -------------------------------------------------------------------------------- 1 | /** \file file.c 2 | PNFile class for unbuffered blocking file descriptor IO. 3 | 4 | Only raw and fast POSIX open,read,write,seek calls on fd. 5 | fgets (aka readline) is only supported on stdin via the \c "read" method. 6 | \see http://stackoverflow.com/questions/1658476/c-fopen-vs-open 7 | 8 | \see the \c buffile library (PNBufFile) for buffered io via FILE* 9 | for fopen, fscanf, fprintf, fread, fgets see there. 10 | \see the aio library (PNAio) for async non-blocking io, via libuv bindings. 11 | 12 | (c) 2008 why the lucky stiff, the freelance professor */ 13 | #include 14 | #include 15 | #include 16 | #include 17 | #include 18 | #include 19 | #include 20 | #include "potion.h" 21 | #include "internal.h" 22 | #include "table.h" 23 | 24 | #ifdef __APPLE__ 25 | # include 26 | # undef environ 27 | # define environ (*_NSGetEnviron()) 28 | #else 29 | extern char **environ; 30 | #endif 31 | 32 | typedef struct PNFile * volatile pn_file; 33 | 34 | /**\memberof PNFile 35 | constructor method. opens a file with 0755 and returns the created PNFile 36 | \param path PNString 37 | \param modestr PNString r,r+,w,w+,a,a+ 38 | \return self or PN_NIL */ 39 | PN potion_file_new(Potion *P, PN cl, PN self, PN path, PN modestr) { 40 | struct PNFile * file = PN_ALLOC(PN_TFILE, struct PNFile); 41 | int fd; 42 | mode_t mode; 43 | if (strcmp(PN_STR_PTR(modestr), "r") == 0) { 44 | mode = O_RDONLY; 45 | } else if (strcmp(PN_STR_PTR(modestr), "r+") == 0) { 46 | mode = O_RDWR; 47 | } else if (strcmp(PN_STR_PTR(modestr), "w") == 0) { 48 | mode = O_WRONLY | O_TRUNC | O_CREAT; 49 | } else if (strcmp(PN_STR_PTR(modestr), "w+") == 0) { 50 | mode = O_RDWR | O_TRUNC | O_CREAT; 51 | } else if (strcmp(PN_STR_PTR(modestr), "a") == 0) { 52 | mode = O_WRONLY | O_CREAT | O_APPEND; 53 | } else if (strcmp(PN_STR_PTR(modestr), "a+") == 0) { 54 | mode = O_RDWR | O_CREAT | O_APPEND; 55 | } else { 56 | // invalid mode 57 | return PN_NIL; 58 | } 59 | if ((fd = open(PN_STR_PTR(path), mode, 0755)) == -1) 60 | return potion_io_error(P, "open"); 61 | file->fd = fd; 62 | file->path = path; 63 | file->mode = mode; 64 | return (PN)file; 65 | } 66 | 67 | /**\memberof PNFile 68 | \c "fd" class method. 69 | \param fd PNInteger 70 | \return a new PNFile object for the already opened file descriptor (sorry, empty path). */ 71 | PN potion_file_with_fd(Potion *P, PN cl, PN self, PN fd) { 72 | struct PNFile *file = PN_ALLOC(PN_TFILE, struct PNFile); 73 | file->fd = PN_INT(fd); 74 | file->path = PN_NIL; 75 | #ifdef F_GETFL 76 | file->mode = fcntl(file->fd, F_GETFL) | O_ACCMODE; 77 | #else 78 | struct stat st; 79 | if (fstat(file->fd, &st) == -1) perror("fstat"); 80 | file->mode = st.st_mode; 81 | #endif 82 | return (PN)file; 83 | } 84 | 85 | /**\memberof PNFile 86 | \c "close" the file 87 | \return PN_NIL */ 88 | PN potion_file_close(Potion *P, PN cl, pn_file self) { 89 | int retval; 90 | while (retval = close(self->fd), retval == -1 && errno == EINTR) ; 91 | self->fd = -1; 92 | return PN_NIL; 93 | } 94 | 95 | /**\memberof PNFile 96 | \c "read" n PNBytes from the file 97 | \param n PNInteger 98 | \return n PNBytes or nil or PNError */ 99 | PN potion_file_read(Potion *P, PN cl, pn_file self, PN n) { 100 | n = PN_INT(n); 101 | char buf[n]; 102 | int r = read(self->fd, buf, n); 103 | if (r == -1) { 104 | return potion_io_error(P, "read"); 105 | //perror("read"); 106 | // TODO: error 107 | //return PN_NUM(-1); 108 | } else if (r == 0) { 109 | return PN_NIL; 110 | } 111 | return potion_byte_str2(P, buf, r); 112 | } 113 | 114 | /**\memberof PNFile 115 | \c "write" a binary representation of obj to the file handle. 116 | \param obj PNString, PNBytes, PNInteger (long or double), PNBoolean (char 0 or 1) 117 | \return PNInteger written bytes or PN_NIL */ 118 | PN potion_file_write(Potion *P, PN cl, pn_file self, PN obj) { 119 | long len = 0; 120 | char *ptr = NULL; 121 | union { double d; long l; char c; } tmp; 122 | //TODO: maybe extract ptr+len to seperate function 123 | if (!PN_IS_PTR(obj)) { 124 | if (!obj) return PN_NIL; //silent 125 | else if (PN_IS_INT(obj)) { 126 | tmp.l = PN_NUM(obj); len = sizeof(tmp); ptr = (char *)&tmp.l; 127 | } 128 | else if (PN_IS_BOOL(obj)) { 129 | tmp.c = (obj == PN_TRUE) ? 1 : 0; len = 1; ptr = (char *)&tmp.c; 130 | } 131 | else { 132 | assert(0 && "Invalid primitive type"); 133 | } 134 | } else { 135 | switch (PN_TYPE(obj)) { 136 | case PN_TSTRING: len = PN_STR_LEN(obj); ptr = PN_STR_PTR(obj); break; 137 | case PN_TBYTES: len = potion_send(obj, PN_STR("length")); ptr = PN_STR_PTR(obj); break; 138 | case PN_TNUMBER: { 139 | tmp.d = PN_DBL(obj); len = sizeof(tmp); ptr = (char *)&tmp.d; 140 | break; 141 | } 142 | default: return potion_type_error(P, obj); 143 | } 144 | } 145 | int r = write(self->fd, ptr, len); 146 | if (r == -1) 147 | return potion_io_error(P, "write"); 148 | return PN_NUM(r); 149 | } 150 | 151 | /**\memberof PNFile 152 | \c "print" a stringification of any object to the filehandle. 153 | Note that \c write prints the binary value of the object. 154 | \param obj any 155 | \return "" or PNError */ 156 | PN potion_file_print(Potion *P, PN cl, pn_file self, PN obj) { 157 | PN r = potion_file_write(P, cl, self, potion_send(obj, PN_string)); 158 | return PN_IS_INT(r) ? PN_STR0 : r; 159 | } 160 | 161 | /**\memberof PNFile 162 | "string" method. some internal descr */ 163 | PN potion_file_string(Potion *P, PN cl, pn_file self) { 164 | int fd = self->fd, rv; 165 | char *buf; 166 | PN str; 167 | if (self->path != PN_NIL && fd != -1) { 168 | rv = asprintf(&buf, "", PN_STR_PTR(self->path), fd); 169 | } else if (fd != -1) { 170 | rv = asprintf(&buf, "", fd); 171 | } else { 172 | rv = asprintf(&buf, ""); 173 | } 174 | if (rv == -1) potion_allocation_error(); 175 | str = potion_str(P, buf); 176 | free(buf); 177 | return str; 178 | } 179 | 180 | /**\memberof Lobby 181 | global "read" method, read next line from stdin via fgets() 182 | \return PNString or or PN_NIL */ 183 | PN potion_lobby_read(Potion *P, PN cl, PN self) { 184 | char line[1024]; 185 | if (fgets(line, 1024, stdin) != NULL) 186 | return potion_str(P, line); 187 | return PN_NIL; 188 | } 189 | 190 | /// set Env global 191 | void potion_file_init(Potion *P) { 192 | PN file_vt = PN_VTABLE(PN_TFILE); 193 | char **env = environ, *key; 194 | PN pe = potion_table_empty(P); 195 | while (*env != NULL) { 196 | for (key = *env; *key != '='; key++); 197 | potion_table_put(P, PN_NIL, pe, PN_STRN(*env, key - *env), 198 | potion_str(P, key + 1)); 199 | env++; 200 | } 201 | potion_send(P->lobby, PN_def, PN_STRN("Env", 3), pe); 202 | potion_method(P->lobby, "read", potion_lobby_read, 0); 203 | 204 | potion_type_constructor_is(file_vt, PN_FUNC(potion_file_new, "path=S,mode=S")); 205 | potion_class_method(file_vt, "fd", potion_file_with_fd, "fd=N"); 206 | potion_method(file_vt, "string", potion_file_string, 0); 207 | potion_method(file_vt, "close", potion_file_close, 0); 208 | potion_method(file_vt, "read", potion_file_read, "n=N"); 209 | potion_method(file_vt, "write", potion_file_write, "str=S"); 210 | potion_method(file_vt, "print", potion_file_print, "obj=o"); 211 | } 212 | -------------------------------------------------------------------------------- /core/load.c: -------------------------------------------------------------------------------- 1 | /** \file load.c 2 | loading of external code, bytecode and shared libs 3 | 4 | (c) 2008 why the lucky stiff, the freelance professor 5 | (c) 2013 by perl11 org */ 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include 12 | #include "potion.h" 13 | #include "internal.h" 14 | #include "table.h" 15 | 16 | static PN potion_load_code(Potion *P, const char *filename) { 17 | PN buf, code; 18 | struct stat stats; 19 | int fd = -1; 20 | PN result = PN_NIL; 21 | // TOCTTOU http://cwe.mitre.org/data/definitions/367.html 22 | fd = open(filename, O_RDONLY | O_BINARY); 23 | if (fd == -1) { 24 | if (stat(filename, &stats) == -1) { 25 | fprintf(stderr, "** %s does not exist.", filename); 26 | } else { 27 | fprintf(stderr, "** could not open %s. check permissions.", filename); 28 | } 29 | return PN_NIL; 30 | } 31 | if (stat(filename, &stats) == -1) { 32 | fprintf(stderr, "** %s vanished!", filename); 33 | close(fd); 34 | return PN_NIL; 35 | } 36 | buf = potion_bytes(P, stats.st_size); 37 | if (read(fd, PN_STR_PTR(buf), stats.st_size) == stats.st_size) { 38 | PN_STR_PTR(buf)[stats.st_size] = '\0'; 39 | code = potion_source_load(P, PN_NIL, buf); 40 | if (!PN_IS_PROTO(code)) { 41 | result = potion_run(P, potion_send( 42 | potion_parse(P, buf, (char *)filename), 43 | PN_compile, potion_str(P, filename), PN_NIL), 44 | POTION_JIT); 45 | } 46 | } else { 47 | fprintf(stderr, "** could not read entire file: %s.", filename); 48 | } 49 | close(fd); 50 | return result; 51 | } 52 | 53 | static char *potion_initializer_name(Potion *P, const char *filename, PN_SIZE len) { 54 | PN_SIZE ext_name_len = 0; 55 | char *allocated_str, *ext_name, *func_name; 56 | while (*(filename + ++ext_name_len) != '.' && ext_name_len <= len); 57 | allocated_str = ext_name = malloc(ext_name_len + 1); 58 | if (allocated_str == NULL) potion_allocation_error(); 59 | strncpy(ext_name, filename, ext_name_len); 60 | ext_name[ext_name_len] = '\0'; 61 | ext_name += ext_name_len; 62 | while (*--ext_name != '/' && ext_name >= allocated_str); 63 | ext_name++; 64 | if (asprintf(&func_name, "Potion_Init_%s", ext_name) == -1) 65 | potion_allocation_error(); 66 | free(allocated_str); 67 | return func_name; 68 | } 69 | 70 | /// \return the handle as mangled int (might be too large) 71 | static PN potion_load_dylib(Potion *P, const char *filename) { 72 | void *handle = dlopen(filename, RTLD_LAZY); // XXX when can we close this? 73 | void (*func)(Potion *); 74 | char *err, *init_func_name; 75 | if (handle == NULL) { 76 | // TODO: error 77 | fprintf(stderr, "** error loading %s: %s\n", filename, dlerror()); 78 | return PN_NIL; 79 | } 80 | init_func_name = potion_initializer_name(P, filename, strlen(filename)); 81 | func = (void (*)(Potion *))dlsym(handle, init_func_name); 82 | err = (char *)dlerror(); 83 | if (err != NULL) { 84 | fprintf(stderr, "** error loading %s in %s: %s\n", init_func_name, filename, err); 85 | free(init_func_name); 86 | dlclose(handle); 87 | return PN_NIL; 88 | } 89 | free(init_func_name); 90 | func(P); 91 | return PN_INT(handle); 92 | } 93 | 94 | static PN pn_loader_path; 95 | static const char *pn_loader_extensions[] = { 96 | ".pnb" 97 | , ".pn" 98 | , POTION_LOADEXT 99 | }; 100 | 101 | static const char *find_extension(char *str) { 102 | int i; 103 | PN_SIZE str_len = strlen(str); 104 | struct stat st; 105 | for (i = 0; 106 | i < sizeof(pn_loader_extensions) / sizeof(void *); 107 | i++) { 108 | PN_SIZE len = strlen(pn_loader_extensions[i]); 109 | char buf[str_len + len + 1]; 110 | strcpy(buf, str); 111 | strcpy(buf + str_len, pn_loader_extensions[i]); 112 | buf[str_len + len] = '\0'; 113 | if (stat(buf, &st) == 0 && S_ISREG(st.st_mode)) 114 | return pn_loader_extensions[i]; 115 | } 116 | return NULL; 117 | } 118 | 119 | char *potion_find_file(Potion *P, char *str, PN_SIZE str_len) { 120 | char *r = NULL; 121 | struct stat st; 122 | if (!str_len) str_len = strlen(str); 123 | PN_TUPLE_EACH(pn_loader_path, i, prefix, { 124 | PN_SIZE prefix_len = PN_STR_LEN(prefix); 125 | char dirname[prefix_len + 1 + str_len + 1]; 126 | char *str_pos = dirname + prefix_len + 1; 127 | char *dot; 128 | const char *ext; 129 | memcpy(str_pos, str, str_len); 130 | dot = memchr(str, '.', str_len); 131 | if (dot == NULL) 132 | dirname[sizeof(dirname) - 1] = '\0'; 133 | else 134 | *dot = '\0'; 135 | memcpy(dirname, PN_STR_PTR(prefix), prefix_len); 136 | dirname[prefix_len] = '/'; 137 | if (stat(dirname, &st) == 0 && S_ISREG(st.st_mode)) { 138 | if (asprintf(&r, "%s", dirname) == -1) potion_allocation_error(); 139 | break; 140 | } else if ((ext = find_extension(dirname)) != NULL) { 141 | if (asprintf(&r, "%s%s", dirname, ext) == -1) potion_allocation_error(); 142 | break; 143 | } else { 144 | char *file; 145 | if ((file = strrchr(str, '/')) == NULL) 146 | file = str; 147 | else 148 | file++; 149 | if (asprintf(&r, "%s/%s", dirname, file) == -1) potion_allocation_error(); 150 | if (stat(r, &st) != 0 || !S_ISREG(st.st_mode)) { 151 | int r_len = prefix_len + 1 + str_len * 2 + 1; 152 | if ((ext = find_extension(r)) == NULL) { free(r); r = NULL; continue; } 153 | r = realloc(r, r_len + strlen(ext)); 154 | if (r == NULL) potion_allocation_error(); 155 | strcpy(r + r_len, ext); 156 | } 157 | break; 158 | } 159 | }); 160 | return r; 161 | } 162 | 163 | PN potion_load(Potion *P, PN cl, PN self, PN file) { 164 | if (!file && PN_IS_STR(self)) 165 | file = self; 166 | char *filename = potion_find_file(P, PN_STR_PTR(file), PN_STR_LEN(file)); 167 | char *file_ext; 168 | PN result = PN_NIL; 169 | if (filename == NULL) { 170 | fprintf(stderr, "** can't find %s\n", PN_STR_PTR(file)); 171 | return PN_NIL; 172 | } 173 | file_ext = filename + strlen(filename); 174 | while (*--file_ext != '.' && file_ext >= filename); 175 | if (file_ext++ != filename) { 176 | if (strcmp(file_ext, "pn") == 0) 177 | result = potion_load_code(P, filename); 178 | else if (strcmp(file_ext, "pnb") == 0) 179 | result = potion_load_code(P, filename); 180 | else if (strcmp(file_ext, &POTION_LOADEXT[1]) == 0) 181 | result = potion_load_dylib(P, filename); 182 | else 183 | fprintf(stderr, "** unrecognized file extension: %s\n", file_ext); 184 | } else { 185 | fprintf(stderr, "** no file extension: %s\n", filename); 186 | } 187 | free(filename); 188 | return result; 189 | } 190 | 191 | void potion_loader_add(Potion *P, PN path) { 192 | PN_PUSH(pn_loader_path, path); 193 | } 194 | 195 | void potion_loader_init(Potion *P) { 196 | pn_loader_path = PN_TUP0(); 197 | // relocatable path - relative to exe in argv[0] 198 | //PN arg0 = potion_send(potion_str(P, "$^X")); // but too early for argv[0] 199 | //if (arg0) PN_PUSH(pn_loader_path, potion_strcat(P, basename(PN_STR_PTR(arg0)), "../lib/potion")); 200 | PN_PUSH(pn_loader_path, potion_str(P, "lib/potion")); 201 | PN_PUSH(pn_loader_path, potion_str(P, POTION_PREFIX"/lib/potion")); 202 | PN_PUSH(pn_loader_path, potion_str(P, ".")); 203 | 204 | potion_define_global(P, potion_str(P, "LOADER_PATH"), pn_loader_path); 205 | potion_method(P->lobby, "load", potion_load, "file=S"); 206 | } 207 | -------------------------------------------------------------------------------- /tools/greg.y: -------------------------------------------------------------------------------- 1 | # -*- mode: antlr; tab-width:8 -*- 2 | # LE Grammar for LE Grammars 3 | # 4 | # Copyright (c) 2007 by Ian Piumarta 5 | # Copyright (c) 2011 by Amos Wenger nddrylliog@gmail.com 6 | # Copyright (c) 2013 by perl11 org 7 | # All rights reserved. 8 | # 9 | # Permission is hereby granted, free of charge, to any person obtaining a 10 | # copy of this software and associated documentation files (the 'Software'), 11 | # to deal in the Software without restriction, including without limitation 12 | # the rights to use, copy, modify, merge, publish, distribute, and/or sell 13 | # copies of the Software, and to permit persons to whom the Software is 14 | # furnished to do so, provided that the above copyright notice(s) and this 15 | # permission notice appear in all copies of the Software. Acknowledgement 16 | # of the use of this Software in supporting documentation would be 17 | # appreciated but is not required. 18 | # 19 | # THE SOFTWARE IS PROVIDED 'AS IS'. USE ENTIRELY AT YOUR OWN RISK. 20 | # 21 | # Last edited: 2013-10-01 11:36:41 rurban 22 | 23 | %{ 24 | # include "greg.h" 25 | 26 | # include 27 | # include 28 | # include 29 | 30 | typedef struct Header Header; 31 | 32 | struct Header { 33 | char *text; 34 | Header *next; 35 | }; 36 | 37 | int verboseFlag= 0; 38 | 39 | static char *trailer= 0; 40 | static Header *headers= 0; 41 | static char *deftrailer= "\n\ 42 | #ifdef YY_MAIN\n\ 43 | int main()\n\ 44 | {\n\ 45 | GREG g;\n\ 46 | yyinit(&g);\n\ 47 | while (yyparse(&g));\n\ 48 | yydeinit(&g);\n\ 49 | return 0;\n\ 50 | }\n\ 51 | #endif\n\ 52 | "; 53 | 54 | void makeHeader(char *text); 55 | void makeTrailer(char *text); 56 | %} 57 | 58 | # Hierarchical syntax 59 | 60 | grammar= - ( declaration | definition )+ trailer? end-of-file 61 | 62 | declaration= '%{' < ( !'%}' . )* > RPERCENT { makeHeader(yytext); } #{YYACCEPT} 63 | 64 | trailer= '%%' < .* > { makeTrailer(yytext); } #{YYACCEPT} 65 | 66 | definition= s:identifier { if (push(beginRule(findRule(yytext, s)))->rule.expression) 67 | fprintf(stderr, "rule '%s' redefined\n", yytext); } 68 | EQUAL expression { Node *e= pop(); Rule_setExpression(pop(), e); } 69 | SEMICOLON? #{YYACCEPT} 70 | 71 | expression= sequence (BAR sequence { Node *f= pop(); push(Alternate_append(pop(), f)); } 72 | )* 73 | 74 | sequence= error (error { Node *f= pop(); push(Sequence_append(pop(), f)); } 75 | )* 76 | 77 | error= prefix (TILDE action { push(makeError(pop(), yytext)); } 78 | )? 79 | 80 | prefix= AND action { push(makePredicate(yytext)); } 81 | | AND suffix { push(makePeekFor(pop())); } 82 | | NOT suffix { push(makePeekNot(pop())); } 83 | | suffix 84 | 85 | suffix= primary (QUESTION { push(makeQuery(pop())); } 86 | | STAR { push(makeStar (pop())); } 87 | | PLUS { push(makePlus (pop())); } 88 | )? 89 | 90 | primary= identifier { push(makeVariable(yytext)); } 91 | COLON identifier !EQUAL { Node *name= makeName(findRule(yytext, 0)); name->name.variable= pop(); push(name); } 92 | | identifier !EQUAL { push(makeName(findRule(yytext, 0))); } 93 | | OPEN expression CLOSE 94 | | literal { push(makeString(yytext)); } 95 | | class { push(makeClass(yytext)); } 96 | | DOT { push(makeDot()); } 97 | | action { push(makeAction(yytext)); } 98 | | BEGIN { push(makePredicate("YY_BEGIN")); } 99 | | END { push(makePredicate("YY_END")); } 100 | 101 | # Lexical syntax 102 | 103 | identifier= < [-a-zA-Z_][-a-zA-Z_0-9]* > - 104 | 105 | literal= ['] < ( !['] char )* > ['] - #' 106 | | ["] < ( !["] char )* > ["] - 107 | 108 | class= '[' < ( !']' range )* > ']' - 109 | 110 | range= char '-' char | char 111 | 112 | char= '\\' [-abefnrtv'"\[\]\\] 113 | | '\\' 'x'[0-9A-Fa-f][0-9A-Fa-f] 114 | | '\\' 'x'[0-9A-Fa-f] 115 | | '\\' [0-3][0-7][0-7] 116 | | '\\' [0-7][0-7]? 117 | | !'\\' . 118 | 119 | 120 | action= '{' < braces* > '}' - 121 | 122 | braces= '{' braces* '}' 123 | | !'}' . 124 | 125 | EQUAL= '=' - 126 | COLON= ':' - 127 | SEMICOLON= ';' - 128 | BAR= '|' - 129 | AND= '&' - 130 | NOT= '!' - 131 | QUESTION= '?' - 132 | STAR= '*' - 133 | PLUS= '+' - 134 | OPEN= '(' - 135 | CLOSE= ')' - 136 | DOT= '.' - 137 | BEGIN= '<' - 138 | END= '>' - 139 | TILDE= '~' - 140 | RPERCENT= '%}' - 141 | 142 | -= (space | comment)* 143 | space= ' ' | '\t' | end-of-line 144 | comment= '#' (!end-of-line .)* end-of-line 145 | end-of-line= '\r\n' | '\n' | '\r' 146 | end-of-file= !. 147 | 148 | %% 149 | 150 | void makeHeader(char *text) 151 | { 152 | Header *header= (Header *)malloc(sizeof(Header)); 153 | header->text= strdup(text); 154 | header->next= headers; 155 | headers= header; 156 | } 157 | 158 | void makeTrailer(char *text) 159 | { 160 | trailer= strdup(text); 161 | } 162 | 163 | static void version(char *name) 164 | { 165 | printf("%s version %d.%d.%d\n", name, GREG_MAJOR, GREG_MINOR, GREG_LEVEL); 166 | } 167 | 168 | static void usage(char *name) 169 | { 170 | version(name); 171 | fprintf(stderr, "usage: %s [