├── 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.broken ├── lists │ ├── map.pn │ ├── alloc.pn │ └── at.pn ├── misc │ ├── load.pn │ └── global.pn ├── closures │ ├── inspect.pn │ ├── nested.pn │ ├── passing.pn │ ├── arg0.pn │ ├── endings.pn.broken │ ├── long.pn │ ├── named.pn │ └── upvals.pn ├── tables │ ├── reverse.pn │ ├── each.pn │ ├── mixedkeys.pn │ ├── big.pn │ ├── auto.pn │ └── basic.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 │ ├── 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 │ ├── kind.pn │ ├── query.pn │ └── callset.pn ├── logic │ ├── or.pn │ ├── and.pn │ └── not.pn ├── data │ ├── string.pn │ ├── grammar.pn │ └── html.pn ├── runtests.sh └── api │ ├── CuTest.h │ ├── gc-test.c │ ├── gc-bench.c │ ├── potion-test.c │ └── CuTest.c ├── doc ├── potion-1.png ├── doc.css └── core-files.txt ├── tools ├── dlfcn-win32 │ ├── lib │ │ └── libdl.a │ └── include │ │ └── dlfcn.h ├── mk-release.sh ├── potion-mode.el ├── greg.h ├── config.sh └── tree.c ├── example ├── fib.pn ├── gcbench-steady.pn ├── recursive.pn ├── spectral-norm.pn ├── gcbench-list.pn ├── gcbench.pn ├── binarytrees-list.pn ├── gcbench-table.pn ├── binarytrees.pn └── fannkuch.pn ├── .travis.yml ├── configure ├── lib └── readline │ ├── Makefile │ ├── readline.c │ ├── linenoise.h │ └── win32fixes.h ├── .gitignore ├── core ├── table.h ├── primitive.c ├── opcodes.h ├── asm.c ├── ast.h ├── lick.c ├── ast.c ├── contrib.c ├── vm-dis.c ├── internal.h ├── asm.h ├── callcc.c ├── file.c ├── gc.h ├── mt19937ar.c ├── number.c ├── load.c ├── internal.c └── string.c ├── INSTALL.md ├── COPYING ├── dist.mak ├── config.mak ├── README └── Makefile /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/lists/map.pn: -------------------------------------------------------------------------------- 1 | n = (1, 2, 3) #=> (1, 2, 3) 2 | -------------------------------------------------------------------------------- /test/misc/load.pn: -------------------------------------------------------------------------------- 1 | load 'test/misc/global' 2 | X #=> X -------------------------------------------------------------------------------- /test/misc/global.pn: -------------------------------------------------------------------------------- 1 | X = 'X', (X, X kind) #=> (X, String) -------------------------------------------------------------------------------- /test/numbers/parens.pn: -------------------------------------------------------------------------------- 1 | (9 + 1) * (6 - 4) 2 | #=> 20 3 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /test/classes/meta.pn: -------------------------------------------------------------------------------- 1 | Q = class 2 | Q meta m = : 0x068d. 3 | Q m #=> 1677 -------------------------------------------------------------------------------- /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/numbers/decimal.pn: -------------------------------------------------------------------------------- 1 | (992.0, 444444444444.0) 2 | #=> (992.0, 444444444444.0) 3 | -------------------------------------------------------------------------------- /test/strings/ord.pn: -------------------------------------------------------------------------------- 1 | 'a' ord string print 2 | 3 | 'aa' ord 4 | 5 | #=> 97nil 6 | -------------------------------------------------------------------------------- /doc/potion-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/marsmining/potion/master/doc/potion-1.png -------------------------------------------------------------------------------- /test/strings/join.pn: -------------------------------------------------------------------------------- 1 | (0.0, 'Potion', 2009) join (" * ") 2 | #=> 0.0 * Potion * 2009 3 | -------------------------------------------------------------------------------- /test/tutorial/01_list.pn: -------------------------------------------------------------------------------- 1 | ("cheese", "bread", "mayo") at (1) print 2 | #=> breadnil 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 | -------------------------------------------------------------------------------- /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/tutorial/02_table.pn: -------------------------------------------------------------------------------- 1 | (language="Potion", pointless=true) at (key="language") print 2 | #=> Potionnil 3 | -------------------------------------------------------------------------------- /tools/dlfcn-win32/lib/libdl.a: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/marsmining/potion/master/tools/dlfcn-win32/lib/libdl.a -------------------------------------------------------------------------------- /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/strings/eval.pn: -------------------------------------------------------------------------------- 1 | hello = 2 | "(x): ('hello ', x) print." eval 3 | hello ('world') 4 | #=> hello worldnil 5 | -------------------------------------------------------------------------------- /test/tables/each.pn: -------------------------------------------------------------------------------- 1 | ("cheese", "bread", "mayo") each (food): 2 | food length string print. 3 | 0 4 | 5 | #=> 6540 6 | -------------------------------------------------------------------------------- /test/tutorial/04_listfun.pn: -------------------------------------------------------------------------------- 1 | foods = ("cheese", "bread", "mayo") 2 | (foods (2), foods (index=2)) 3 | #=> (mayo, mayo) 4 | -------------------------------------------------------------------------------- /test/objects/inspect.pn: -------------------------------------------------------------------------------- 1 | (40) string print 2 | "elephant" length string print 3 | string print 4 | 5 | #=> (40)8Lobbynil 6 | -------------------------------------------------------------------------------- /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/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 | -------------------------------------------------------------------------------- /example/fib.pn: -------------------------------------------------------------------------------- 1 | fib = (n): 2 | if (n < 2): n. else: fib (n - 1) + fib (n - 2).. 3 | 4 | n = 40 5 | ("fib(", n, ")= ", fib (n), "\n") join print 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/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/numbers/type.pn: -------------------------------------------------------------------------------- 1 | (1, 1.0) each (x): x integer? string print. 2 | 3 | (1, 1.0) each (x): x float? string print. 4 | 5 | #=> truefalsefalsetrue(1, 1.0) 6 | -------------------------------------------------------------------------------- /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/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 | -------------------------------------------------------------------------------- /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/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/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/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.nil 7 | -------------------------------------------------------------------------------- /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/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.broken: -------------------------------------------------------------------------------- 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/objects/kind.pn: -------------------------------------------------------------------------------- 1 | (10 kind == Number, 2 | nil kind == NilKind, 3 | "mailbox" kind == String, 4 | 10 kind == Boolean, 5 | nil kind == Boolean, 6 | "mailbox" kind == Boolean) 7 | #=> (true, true, true, false, false, false) 8 | -------------------------------------------------------------------------------- /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/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 | #=> nil 10 | -------------------------------------------------------------------------------- /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/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 | -------------------------------------------------------------------------------- /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.nil 8 | -------------------------------------------------------------------------------- /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/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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: c 2 | compiler: 3 | - clang 4 | # - gcc 5 | 6 | env: 7 | - DEBUG=0 8 | - DEBUG=1 9 | 10 | # not yet used: 11 | #before_install: 12 | # - git submodule update --init --recursive 13 | #install: 14 | # - sudo apt-get update -qq 15 | # - sudo apt-get install -qq libdisasm-dev 16 | 17 | script: make config CC=$CC DEBUG=$DEBUG; make && make test 18 | 19 | notifications: 20 | irc: "irc.perl.org#perl11" 21 | -------------------------------------------------------------------------------- /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/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 | 22 | z = (): 23 | z4 = (b=2) 24 | z4. 25 | 26 | (cl (), cl2 (), cl3 (), cl4 (12), o, z1, z2, z3, z()) 27 | #=> (function(), 17, 45, 67, 23, true, 16, (nil, nil), (b=2)) 28 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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!

nil 17 | -------------------------------------------------------------------------------- /lib/readline/Makefile: -------------------------------------------------------------------------------- 1 | include ../../config.inc 2 | INCS += -I../../core 3 | LIBS = -L../.. -lpotion 4 | SRC = linenoise.c 5 | ifeq ($(WIN32),1) 6 | SRC += win32fixes.c 7 | LIBS += -lws2_32 8 | endif 9 | 10 | all: readline${LOADEXT} 11 | 12 | %${LOADEXT}: %.c 13 | @if [ -f ../../libpotion.a ]; then mv ../../libpotion.a ../../libpotion.a.tmp; fi 14 | @$(CC) $(CFLAGS) -o $@ $(INCS) $(LDDLLFLAGS) $(SRC) $< $(LIBS) 15 | @if [ -f ../../libpotion.a.tmp ]; then mv ../../libpotion.a.tmp ../../libpotion.a; fi 16 | 17 | test: 18 | 19 | clean: 20 | @rm -f ../readline${LOADEXT} readline${LOADEXT} 21 | -------------------------------------------------------------------------------- /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/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/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 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /potion 2 | /potion.exe 3 | /potion-s 4 | /potion-s.exe 5 | /tools/greg 6 | /tools/greg.exe 7 | /tools/config.c 8 | /config.inc 9 | /core/config.h 10 | /core/version.h 11 | /core/vm-arm.c 12 | /core/pn-scan.c 13 | /core/pn-gram.[ch] 14 | /core/pn-gram.out 15 | /core/*.i 16 | /core/*.o 17 | /core/*.opic 18 | /test/api/potion-test 19 | /test/api/potion-test.exe 20 | /test/api/gc-test 21 | /test/api/gc-test.exe 22 | /test/api/*.o 23 | /config.inc 24 | /.gdbinit 25 | syntax.c 26 | *.pnb 27 | ._* 28 | .DS_Store 29 | readline.so 30 | readline.dll 31 | readline.bundle 32 | /libpotion.a 33 | /libpotion.so 34 | /libpotion.dll 35 | /libpotion.dylib 36 | /history.txt 37 | /pkg 38 | /doc/*.html 39 | /TAGS 40 | /GPATH 41 | /GRTAGS 42 | /GTAGS 43 | /HTML 44 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /core/table.h: -------------------------------------------------------------------------------- 1 | // 2 | // table.h 3 | // the central table type, based on khash 4 | // 5 | // (c) 2008 why the lucky stiff, the freelance professor 6 | // 7 | #ifndef POTION_TABLE_H 8 | #define POTION_TABLE_H 9 | 10 | #include "potion.h" 11 | #include "internal.h" 12 | #include "khash.h" 13 | 14 | typedef PN (*PN_MCACHE_FUNC)(unsigned int hash); 15 | // TODO: ensure the random PNUniq is truly unique for strings 16 | typedef PN (*PN_IVAR_FUNC)(PNUniq hash); 17 | 18 | struct PNVtable { 19 | PN_OBJECT_HEADER 20 | PNType parent, type; 21 | PN name; 22 | int ivlen; 23 | PN ivars; 24 | vPN(Table) methods; 25 | vPN(Vtable) meta; 26 | PN ctor, call, callset; 27 | PN_MCACHE_FUNC mcache; 28 | PN_IVAR_FUNC ivfunc; 29 | }; 30 | 31 | struct PNTable { 32 | PN_OBJECT_HEADER 33 | PN_TABLE_HEADER 34 | char table[0]; 35 | }; 36 | 37 | KHASH_MAP_INIT_PN(PN, struct PNTable); 38 | KHASH_MAP_INIT_STR(str, struct PNTable); 39 | 40 | #endif 41 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /core/primitive.c: -------------------------------------------------------------------------------- 1 | // 2 | // primitive.c 3 | // methods for the primitive types 4 | // 5 | // (c) 2008 why the lucky stiff, the freelance professor 6 | // 7 | #include 8 | #include 9 | #include "potion.h" 10 | #include "internal.h" 11 | 12 | static PN potion_nil_is_nil(Potion *P, PN closure, PN self) { 13 | return PN_TRUE; 14 | } 15 | 16 | static PN potion_bool_number(Potion *P, PN closure, PN self) { 17 | return PN_NUM(PN_TEST(self)); 18 | } 19 | 20 | static PN potion_bool_string(Potion *P, PN closure, PN self) { 21 | if (PN_TEST(self)) return potion_str(P, "true"); 22 | return potion_str(P, "false"); 23 | } 24 | 25 | PN potion_any_is_nil(Potion *P, PN closure, PN self) { 26 | return PN_FALSE; 27 | } 28 | 29 | void potion_primitive_init(Potion *P) { 30 | PN nil_vt = PN_VTABLE(PN_TNIL); 31 | PN boo_vt = PN_VTABLE(PN_TBOOLEAN); 32 | potion_method(nil_vt, "nil?", potion_nil_is_nil, 0); 33 | potion_method(nil_vt, "number", potion_bool_number, 0); 34 | potion_send(nil_vt, PN_def, PN_string, potion_str(P, "nil")); 35 | potion_method(boo_vt, "number", potion_bool_number, 0); 36 | potion_method(boo_vt, "string", potion_bool_string, 0); 37 | } 38 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /tools/mk-release.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | case `uname -s` in 3 | *Linux) # native to x86_64, cross to i686 via -m32, i686-w64-mingw32-gcc and x86_64-w64-mingw32-gcc 4 | CC="clang-3.3" 5 | CROSS="i686-w64-mingw32-gcc x86_64-w64-mingw32-gcc" ;; 6 | Darwin) # native clang not stable enough (16byte %esp alignment), use ports gcc 7 | CC="gcc-mp-4.8" 8 | CROSS="i386-mingw32-gcc" ;; 9 | CYGWIN*) # native via gcc4 10 | CC="gcc-4" 11 | if [ `uname -m` = x86_64 ]; then #Cygwin64 12 | CC="gcc" 13 | fi 14 | ;; 15 | esac 16 | #LATER evtl.: ppc, arm, darwin pkg 17 | 18 | dorelease() { 19 | make realclean 20 | echo make CC="$1" 21 | make CC="$1" DEBUG=0 22 | make test 23 | make dist 24 | } 25 | 26 | docross() { 27 | make clean 28 | rm config.inc 29 | echo make CC="$1" 30 | make -s -f config.mak CC="$1" DEBUG=0 31 | touch tools/greg 32 | touch core/syntax.c 33 | make CC="$1" DEBUG=0 34 | make dist 35 | } 36 | 37 | for c in $CC; do 38 | dorelease "$c" 39 | done 40 | 41 | # build greg and syntax.c native 42 | make clean 43 | make core/syntax.c 44 | 45 | for c in $CROSS; do 46 | docross "$c" 47 | done 48 | 49 | case `uname -s` in 50 | *Linux) dorelease "gcc -m32" ;; 51 | esac 52 | -------------------------------------------------------------------------------- /example/fannkuch.pn: -------------------------------------------------------------------------------- 1 | range = (a, b): 2 | i = 0, l = list(b-a+1) 3 | while (a + i <= b): 4 | l (i) = a + i++. 5 | l. 6 | 7 | fannkuch = (n): 8 | flips = 0, maxf = 0, k = 0, m = n - 1, r = n, check = 0 9 | perml = range(0, n), count = list(n), perm = list(n) 10 | 11 | loop: 12 | if (check < 30): 13 | perml join print, "\n" print 14 | check++. 15 | 16 | while (r != 1): 17 | count (r-1) = r 18 | r--. 19 | 20 | if (perml (0) != 0 and perml (m) != m): 21 | flips = 0, i = 1 22 | while (i < n): 23 | perm (i) = perml (i) 24 | i++. 25 | k = perml (0) 26 | loop: 27 | i = 1, j = k - 1 28 | while (i < j): 29 | t = perm (i), perm (i) = perm (j), perm (j) = t 30 | i++, j--. 31 | flips++ 32 | j = perm (k), perm (k) = k, k = j 33 | if (k == 0): break. 34 | . 35 | if (flips > maxf): maxf = flips. 36 | . 37 | 38 | loop: 39 | if (r == n): 40 | maxf string print, "\n" print 41 | return (maxf). 42 | 43 | i = 0, j = perml (0) 44 | while (i < r): 45 | k = i + 1 46 | perml (i) = perml (k) 47 | i = k. 48 | perml (r) = j 49 | 50 | j = count (r) - 1 51 | count (r) = j 52 | if (j > 0): break. 53 | r++ 54 | _ n 55 | 56 | fannkuch(11) 57 | -------------------------------------------------------------------------------- /core/opcodes.h: -------------------------------------------------------------------------------- 1 | // 2 | // opcodes.h 3 | // the Potion VM instruction set (heavily based on Lua's) 4 | // 5 | // (c) 2008 why the lucky stiff, the freelance professor 6 | // 7 | #ifndef POTION_OPCODES_H 8 | #define POTION_OPCODES_H 9 | 10 | #if defined(__GNUC__) 11 | #pragma pack(1) 12 | #else 13 | #pragma pack(push, 1) 14 | #endif 15 | 16 | typedef struct { 17 | u8 code:8; 18 | int a:12; 19 | int b:12; 20 | } PN_OP; 21 | 22 | #if defined(__GNUC__) 23 | #pragma pack() 24 | #else 25 | #pragma pack(pop) 26 | #endif 27 | 28 | #define PN_OP_AT(asmb, n) ((PN_OP *)((PNFlex *)asmb)->ptr)[n] 29 | #define PN_OP_LEN(asmb) (PN_FLEX_SIZE(asmb) / sizeof(PN_OP)) 30 | 31 | enum PN_OPCODE { 32 | OP_NONE, 33 | OP_MOVE, 34 | OP_LOADK, 35 | OP_LOADPN, 36 | OP_SELF, 37 | OP_NEWTUPLE, 38 | OP_SETTUPLE, 39 | OP_GETLOCAL, 40 | OP_SETLOCAL, 41 | OP_GETUPVAL, 42 | OP_SETUPVAL, 43 | OP_GLOBAL, 44 | OP_GETTABLE, 45 | OP_SETTABLE, 46 | OP_NEWLICK, 47 | OP_GETPATH, 48 | OP_SETPATH, 49 | OP_ADD, 50 | OP_SUB, 51 | OP_MULT, 52 | OP_DIV, 53 | OP_REM, 54 | OP_POW, 55 | OP_NOT, 56 | OP_CMP, 57 | OP_EQ, 58 | OP_NEQ, 59 | OP_LT, 60 | OP_LTE, 61 | OP_GT, 62 | OP_GTE, 63 | OP_BITN, 64 | OP_BITL, 65 | OP_BITR, 66 | OP_DEF, 67 | OP_BIND, 68 | OP_MESSAGE, 69 | OP_JMP, 70 | OP_TEST, 71 | OP_TESTJMP, 72 | OP_NOTJMP, 73 | OP_NAMED, 74 | OP_CALL, 75 | OP_CALLSET, 76 | OP_TAILCALL, 77 | OP_RETURN, 78 | OP_PROTO, 79 | OP_CLASS 80 | }; 81 | 82 | #endif 83 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /core/asm.c: -------------------------------------------------------------------------------- 1 | // 2 | // asm.c 3 | // some assembler functions 4 | // 5 | // (c) 2008 why the lucky stiff, the freelance professor 6 | // 7 | #include 8 | #include 9 | #include 10 | #include "potion.h" 11 | #include "internal.h" 12 | #include "opcodes.h" 13 | #include "asm.h" 14 | 15 | PNAsm *potion_asm_new(Potion *P) { 16 | int siz = ASM_UNIT - sizeof(PNAsm); 17 | PNAsm * volatile asmb = PN_FLEX_NEW(asmb, PN_TBYTES, PNAsm, siz); 18 | return asmb; 19 | } 20 | 21 | PNAsm *potion_asm_clear(Potion *P, PNAsm * volatile asmb) { 22 | asmb->len = 0; 23 | PN_MEMZERO_N(asmb->ptr, u8, asmb->siz); 24 | return asmb; 25 | } 26 | 27 | PNAsm *potion_asm_put(Potion *P, PNAsm * volatile asmb, PN val, size_t len) { 28 | u8 *ptr; 29 | PN_FLEX_NEEDS(len, asmb, PN_TBYTES, PNAsm, ASM_UNIT); 30 | ptr = asmb->ptr + asmb->len; 31 | 32 | if (len == sizeof(u8)) 33 | *ptr = (u8)val; 34 | else if (len == sizeof(int)) 35 | *((int *)ptr) = (int)val; 36 | else if (len == sizeof(PN)) 37 | *((PN *)ptr) = val; 38 | 39 | asmb->len += len; 40 | return asmb; 41 | } 42 | 43 | PNAsm *potion_asm_op(Potion *P, PNAsm * volatile asmb, u8 ins, int _a, int _b) { 44 | PN_OP *pos; 45 | PN_FLEX_NEEDS(sizeof(PN_OP), asmb, PN_TBYTES, PNAsm, ASM_UNIT); 46 | pos = (PN_OP *)(asmb->ptr + asmb->len); 47 | 48 | pos->code = ins; 49 | pos->a = _a; 50 | pos->b = _b; 51 | 52 | asmb->len += sizeof(PN_OP); 53 | return asmb; 54 | } 55 | 56 | PNAsm *potion_asm_write(Potion *P, PNAsm * volatile asmb, char *str, size_t len) { 57 | char *ptr; 58 | PN_FLEX_NEEDS(len, asmb, PN_TBYTES, PNAsm, ASM_UNIT); 59 | ptr = (char *)asmb->ptr + asmb->len; 60 | PN_MEMCPY_N(ptr, str, char, len); 61 | asmb->len += len; 62 | return asmb; 63 | } 64 | -------------------------------------------------------------------------------- /core/ast.h: -------------------------------------------------------------------------------- 1 | // 2 | // ast.h 3 | // the ast for Potion code in-memory 4 | // 5 | // (c) 2008 why the lucky stiff, the freelance professor 6 | // 7 | #ifndef POTION_AST_H 8 | #define POTION_AST_H 9 | 10 | typedef struct { 11 | PN v; 12 | PN b; 13 | } PNArg; 14 | 15 | enum PN_AST { 16 | AST_CODE, 17 | AST_VALUE, 18 | AST_ASSIGN, 19 | AST_NOT, 20 | AST_OR, 21 | AST_AND, 22 | AST_CMP, 23 | AST_EQ, 24 | AST_NEQ, 25 | AST_GT, 26 | AST_GTE, 27 | AST_LT, 28 | AST_LTE, 29 | AST_PIPE, 30 | AST_CARET, 31 | AST_AMP, 32 | AST_WAVY, 33 | AST_BITL, 34 | AST_BITR, 35 | AST_PLUS, 36 | AST_MINUS, 37 | AST_INC, 38 | AST_TIMES, 39 | AST_DIV, 40 | AST_REM, 41 | AST_POW, 42 | AST_MESSAGE, 43 | AST_PATH, 44 | AST_QUERY, 45 | AST_PATHQ, 46 | AST_EXPR, 47 | AST_TABLE, 48 | AST_BLOCK, 49 | AST_LICK, 50 | AST_PROTO 51 | }; 52 | 53 | #define PN_TOK_MISSING 0x10000 54 | 55 | #define PN_AST(T, A) potion_source(P, AST_##T, A, PN_NIL, PN_NIL) 56 | #define PN_AST2(T, A, B) potion_source(P, AST_##T, A, B, PN_NIL) 57 | #define PN_OP(T, A, B) potion_source(P, T, A, B, PN_NIL) 58 | #define PN_AST3(T, A, B, C) potion_source(P, AST_##T, A, B, C) 59 | #define PN_PART(S) ((struct PNSource *)S)->part 60 | #define PN_S(S, N) ((struct PNSource *)S)->a[N] 61 | #define PN_CLOSE(B) ({ \ 62 | PN endname = B; \ 63 | if (PN_IS_TUPLE(endname)) endname = PN_TUPLE_AT(endname, 0); \ 64 | if (endname != PN_NIL) { \ 65 | if (PN_PART(endname) == AST_EXPR) endname = PN_TUPLE_AT(PN_S(endname, 0), 0); \ 66 | if (PN_PART(endname) == AST_MESSAGE || PN_PART(endname) == AST_PATH) \ 67 | endname = PN_S(endname, 0); \ 68 | if (P->unclosed == endname) { P->unclosed = PN_NIL; } \ 69 | } \ 70 | }) 71 | 72 | PN potion_source(Potion *, u8, PN, PN, PN); 73 | 74 | #endif 75 | -------------------------------------------------------------------------------- /core/lick.c: -------------------------------------------------------------------------------- 1 | // 2 | // lick.c 3 | // the interleaved data format 4 | // 5 | // (c) 2008 why the lucky stiff, the freelance professor 6 | // 7 | #include 8 | #include 9 | #include "potion.h" 10 | #include "internal.h" 11 | 12 | PN potion_lick(Potion *P, PN name, PN inner, PN attr) { 13 | vPN(Lick) lk = PN_ALLOC(PN_TLICK, struct PNLick); 14 | lk->name = name; 15 | lk->attr = attr; 16 | lk->inner = inner; 17 | return (PN)lk; 18 | } 19 | 20 | PN potion_lick_attr(Potion *P, PN cl, PN self) { 21 | return ((struct PNLick *)self)->attr; 22 | } 23 | 24 | PN potion_lick_licks(Potion *P, PN cl, PN self) { 25 | PN licks = ((struct PNLick *)self)->inner; 26 | if (PN_IS_TUPLE(licks)) return licks; 27 | return PN_NIL; 28 | } 29 | 30 | PN potion_lick_name(Potion *P, PN cl, PN self) { 31 | return ((struct PNLick *)self)->name; 32 | } 33 | 34 | PN potion_lick_text(Potion *P, PN cl, PN self) { 35 | PN text = ((struct PNLick *)self)->inner; 36 | if (PN_IS_STR(text)) return text; 37 | return PN_NIL; 38 | } 39 | 40 | PN potion_lick_string(Potion *P, PN cl, PN self) { 41 | PN out = potion_byte_str(P, ""); 42 | potion_bytes_obj_string(P, out, ((struct PNLick *)self)->name); 43 | if (((struct PNLick *)self)->inner != PN_NIL) { 44 | pn_printf(P, out, " "); 45 | potion_bytes_obj_string(P, out, ((struct PNLick *)self)->inner); 46 | } 47 | if (((struct PNLick *)self)->attr != PN_NIL) { 48 | pn_printf(P, out, " "); 49 | potion_bytes_obj_string(P, out, ((struct PNLick *)self)->attr); 50 | } 51 | return PN_STR_B(out); 52 | } 53 | 54 | void potion_lick_init(Potion *P) { 55 | PN lk_vt = PN_VTABLE(PN_TLICK); 56 | potion_method(lk_vt, "attr", potion_lick_attr, 0); 57 | potion_method(lk_vt, "licks", potion_lick_licks, 0); 58 | potion_method(lk_vt, "name", potion_lick_name, 0); 59 | potion_method(lk_vt, "string", potion_lick_string, 0); 60 | potion_method(lk_vt, "text", potion_lick_text, 0); 61 | } 62 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /core/ast.c: -------------------------------------------------------------------------------- 1 | // 2 | // ast.c 3 | // the ast for Potion code in-memory 4 | // 5 | // (c) 2008 why the lucky stiff, the freelance professor 6 | // 7 | #include 8 | #include 9 | #include "potion.h" 10 | #include "internal.h" 11 | #include "ast.h" 12 | 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 | "message", "path", "query", "pathq", "expr", "table", 18 | "block", "lick", "proto" 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 27 | }; 28 | 29 | PN potion_source(Potion *P, u8 p, PN a, PN b, PN c) { 30 | vPN(Source) t = PN_ALLOC_N(PN_TSOURCE, struct PNSource, 3 * sizeof(PN)); 31 | t->a[0] = t->a[1] = t->a[2] = 0; 32 | // TODO: potion_ast_sizes[p] * sizeof(PN) (then fix gc_copy) 33 | 34 | t->part = p; 35 | t->a[0] = a; 36 | if (potion_ast_sizes[p] > 1) t->a[1] = b; 37 | if (potion_ast_sizes[p] > 2) t->a[2] = c; 38 | return (PN)t; 39 | } 40 | 41 | PN potion_source_name(Potion *P, PN cl, PN self) { 42 | vPN(Source) t = (struct PNSource *)self; 43 | return potion_str(P, potion_ast_names[t->part]); 44 | } 45 | 46 | PN potion_source_string(Potion *P, PN cl, PN self) { 47 | int i, n; 48 | vPN(Source) t = (struct PNSource *)self; 49 | PN out = potion_byte_str(P, potion_ast_names[t->part]); 50 | n = potion_ast_sizes[t->part]; 51 | for (i = 0; i < n; i++) { 52 | pn_printf(P, out, " "); 53 | if (i == 0 && n > 1) pn_printf(P, out, "("); 54 | potion_bytes_obj_string(P, out, t->a[i]); 55 | if (i == n - 1 && n > 1) pn_printf(P, out, ")"); 56 | } 57 | return PN_STR_B(out); 58 | } 59 | 60 | void potion_source_init(Potion *P) { 61 | PN src_vt = PN_VTABLE(PN_TSOURCE); 62 | potion_method(src_vt, "compile", potion_source_compile, 0); // in compile.c 63 | potion_method(src_vt, "name", potion_source_name, 0); 64 | potion_method(src_vt, "string", potion_source_string, 0); 65 | } 66 | -------------------------------------------------------------------------------- /test/runtests.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # usage: test/runtests.sh [testfile] 3 | # cmd="valgrind ./potion" test/runtests.sh 4 | 5 | cmd=${cmd:-./potion} 6 | ECHO=/bin/echo 7 | SED=sed 8 | EXPR=expr 9 | 10 | count=0; failed=0; pass=0 11 | EXT=pn; 12 | cmdi="$cmd -I"; cmdx="$cmdi -X"; 13 | cmdc="$cmd -c"; extc=b 14 | 15 | if test -z $1; then 16 | ${ECHO} running potion API tests; 17 | test/api/potion-test; 18 | ${ECHO} running GC tests; 19 | test/api/gc-test; 20 | fi 21 | 22 | while [ $pass -lt 3 ]; do 23 | ${ECHO}; 24 | if [ $pass -eq 0 ]; then 25 | t=0; 26 | whattests="$cmd VM tests" 27 | elif [ $pass -eq 1 ]; then 28 | t=1; 29 | whattests="$cmd compiler tests" 30 | elif [ $pass -eq 2 ]; then 31 | t=2; 32 | whattests="$cmd JIT tests" 33 | jit=`$cmd -v | sed "/jit=1/!d"`; 34 | if [ "$jit" = "" ]; then 35 | pass=`expr $pass + 1` 36 | break 37 | fi; 38 | fi 39 | 40 | if test -n "$1" && test -f "$1"; then 41 | what=$1 42 | if [ ${what%.pn} = $what -a $EXT = pn -a $pass -le 3 ]; then 43 | ${ECHO} skipping potion 44 | break 45 | fi 46 | else 47 | what=test/**/*.$EXT 48 | fi 49 | 50 | ${ECHO} running $whattests 51 | 52 | for f in $what; do 53 | look=`cat $f | sed "/\#=>/!d; s/.*\#=> //"` 54 | #echo look=$look 55 | if [ $t -eq 0 ]; then 56 | echo $cmdi -B $f 57 | for=`$cmdi -B $f | sed "s/\n$//"` 58 | elif [ $t -eq 1 ]; then 59 | echo $cmdc $f 60 | $cmdc $f > /dev/null 61 | fb=$f$extc 62 | echo $cmdi -B $fb 63 | for=`$cmdi -B $fb | sed "s/\n$//"` 64 | rm -rf $fb 65 | else 66 | echo $cmdx $f 67 | for=`$cmdx $f | sed "s/\n$//"` 68 | fi; 69 | if [ "$look" != "$for" ]; then 70 | ${ECHO} 71 | ${ECHO} "** $f: expected <$look>, but got <$for>" 72 | failed=`expr $failed + 1` 73 | else 74 | # ${ECHO} -n . 75 | jit=`$cmd -v | ${SED} "/jit=1/!d"` 76 | if [ "$jit" = "" ]; then 77 | ${ECHO} "* skipping" 78 | break 79 | fi 80 | fi 81 | count=`expr $count + 1` 82 | done 83 | pass=`expr $pass + 1` 84 | done 85 | 86 | ${ECHO} 87 | if [ $failed -gt 0 ]; then 88 | ${ECHO} "$failed FAILS ($count tests)" 89 | else 90 | ${ECHO} "OK ($count tests)" 91 | fi 92 | 93 | -------------------------------------------------------------------------------- /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 | ## ~ the latest potion ~ 20 | 21 | To build the bleeding edge, you will need 22 | GNU make, binutils and gcc or clang. 23 | Favor clang over gcc, gcc-4.6.3 is broken, at least on ubuntu. 24 | 25 | $ git clone --branch master git://github.com/perl11/potion.git 26 | $ cd potion 27 | $ make 28 | 29 | ## ~ installing ~ 30 | 31 | $ sudo make install 32 | 33 | ## ~ building on windows ~ 34 | 35 | Potion's win32 binaries are built using MinGW. 36 | 37 | 38 | It's a bit hard to setup mingw and gmake on Windows. 39 | I usually run a shell under Cygwin and add MinGW 40 | to my $PATH. 41 | 42 | Once that's all done, 43 | 44 | $ make 45 | 46 | The easiest way to do this, actually, is on Linux or Darwin. 47 | On Ubuntu, if you have MinGW installed, 48 | 49 | $ make; make clean 50 | $ make config CC=i586-mingw32msvc-gcc 51 | $ touch core/syntax.c 52 | $ make && make dist 53 | 54 | This will first create a native greg and core/syntax.c, 55 | sets CROSS=1 and cross-compile with the given CC. 56 | See tools/mk-release.sh 57 | make test will not work, you need to copy a make dist tarball 58 | to the machine and test it there. 59 | 60 | ## ~ building on bsd ~ 61 | 62 | BSD make is not supported. 63 | You can either install gnu make (gmake) 64 | 65 | $ sudo port install gmake 66 | 67 | or try ./configure which creates a special BSD config.mk 68 | 69 | or try to merge 'master' with the branch 'bsd' 70 | 71 | $ git merge bsd 72 | ... resolve conflicts, or not 73 | 74 | ## ~ building with a strict C++ compiler ~ 75 | 76 | potion does not support strict C++ compilers. 77 | 78 | Either add a C dialect to CC in config.inc (i.e. -std=c89), 79 | 80 | g++ --help=C; clang++ -x C -std=gnu89 81 | 82 | or try to merge with the branch 'p2-c++'. 83 | 84 | ## ~ creating documentation ~ 85 | 86 | This is required for make install and release admins. 87 | You'll need 88 | 89 | redcloth to convert .textile to html, 90 | doxygen (1.8 or 1.9), and 91 | GNU global for gtags and htags 92 | 93 | -------------------------------------------------------------------------------- /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 | 11 | HOWEVER: 12 | Be it known, parts of the object model taken from obj.c 13 | (c) 2007 Ian Piumarta 14 | (MIT licensed) 15 | And, also, the design of the VM bytecode is from Lua 16 | (c) 1994-2006 Lua.org, PUC-Rio 17 | (MIT licensed) 18 | 19 | The Mersenne Twister (MT19937) 20 | (c) 1997-2002, Makoto Matsumoto and Takuji Nishimura (MIT licensed) 21 | 22 | Decimal code based on ARPREC, an arbitrary-precision lib (BSD licensed) 23 | (c) 2003-2009 Lawrence Berkeley Natl Lab 24 | David H. Bailey, Yozo Hida, Karthik Jeyabalan, Xiaoye S. Li, Brandon Thompson 25 | 26 | Lastly, khash.h 27 | (c) 2008, by Attractive Chaos 28 | (MIT licensed) 29 | 30 | Permission is hereby granted, free of charge, to any person 31 | obtaining a copy of this software and associated documentation 32 | files (the "Software"), to deal in the Software without restriction, 33 | including without limitation the rights to use, copy, modify, merge, 34 | publish, distribute, sublicense, and/or sell copies of the Software, 35 | and to permit persons to whom the Software is furnished to do so, 36 | subject to the following conditions: 37 | 38 | The above copyright notice and this permission notice shall be 39 | included in all copies or substantial portions of the Software. 40 | 41 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF 42 | ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED 43 | TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A 44 | PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT 45 | SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR 46 | OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT 47 | OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 48 | WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 49 | SOFTWARE. 50 | 51 | -------------------------------------------------------------------------------- /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 | "each" "eval" "exit" "first" "float?" "forward" "here" "integer" 45 | "integer?" "join" "kind" "last" "length" "licks" "list" "load" "meta" 46 | "name" "nil?" "number" "ord" "pop" "print" "push" "put" "rand" "read" 47 | "remove" "reverse" "self" "send" "slice" "sqrt" "srand" "step" "string" 48 | "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 | -------------------------------------------------------------------------------- /test/api/CuTest.h: -------------------------------------------------------------------------------- 1 | #ifndef CU_TEST_H 2 | #define CU_TEST_H 3 | 4 | #include 5 | #include 6 | 7 | /* CuString */ 8 | 9 | char* CuStrAlloc(int size); 10 | char* CuStrCopy(char* old); 11 | 12 | #define CU_ALLOC(TYPE) ((TYPE*) malloc(sizeof(TYPE))) 13 | 14 | #define HUGE_STRING_LEN 8192 15 | #define STRING_MAX 256 16 | #define STRING_INC 256 17 | 18 | typedef struct 19 | { 20 | int length; 21 | int size; 22 | char* buffer; 23 | } CuString; 24 | 25 | void CuStringInit(CuString* str); 26 | CuString* CuStringNew(void); 27 | void CuStringRead(CuString* str, char* path); 28 | void CuStringAppend(CuString* str, char* text); 29 | void CuStringAppendLen(CuString* str, char* text, long length); 30 | void CuStringAppendChar(CuString* str, char ch); 31 | void CuStringAppendFormat(CuString* str, char* format, ...); 32 | void CuStringResize(CuString* str, int newSize); 33 | void CuStringFree(CuString* str); 34 | 35 | void CuStringFree(CuString *str); 36 | 37 | /* CuTest */ 38 | 39 | typedef struct CuTest CuTest; 40 | 41 | typedef void (*TestFunction)(CuTest *); 42 | 43 | struct CuTest 44 | { 45 | char* name; 46 | TestFunction function; 47 | int failed; 48 | int ran; 49 | char* message; 50 | jmp_buf *jumpBuf; 51 | }; 52 | 53 | void CuTestInit(CuTest* t, char* name, TestFunction function); 54 | CuTest* CuTestNew(char* name, TestFunction function); 55 | void CuFail(CuTest* tc, char* message); 56 | void CuAssert(CuTest* tc, char* message, int condition); 57 | void CuAssertTrue(CuTest* tc, int condition); 58 | void CuAssertStrEquals(CuTest* tc, char* expected, char* actual); 59 | void CuAssertIntEquals(CuTest* tc, char *message, int expected, int actual); 60 | void CuAssertPtrEquals(CuTest* tc, void* expected, void* actual); 61 | void CuAssertPtrNotNull(CuTest* tc, void* pointer); 62 | void CuTestRun(CuTest* tc); 63 | 64 | /* CuSuite */ 65 | 66 | #define MAX_TEST_CASES 1024 67 | 68 | #define SUITE_ADD_TEST(SUITE,TEST) CuSuiteAdd(SUITE, CuTestNew(#TEST, TEST)) 69 | 70 | typedef struct 71 | { 72 | int count; 73 | CuTest* list[MAX_TEST_CASES]; 74 | int failCount; 75 | 76 | } CuSuite; 77 | 78 | 79 | void CuSuiteInit(CuSuite* testSuite); 80 | CuSuite* CuSuiteNew(); 81 | void CuSuiteFree(CuSuite* testSuite); 82 | void CuSuiteAdd(CuSuite* testSuite, CuTest *testCase); 83 | void CuSuiteAddSuite(CuSuite* testSuite, CuSuite* testSuite2); 84 | void CuSuiteRun(CuSuite* testSuite); 85 | void CuSuiteSummary(CuSuite* testSuite, CuString* summary); 86 | void CuSuiteDetails(CuSuite* testSuite, CuString* details); 87 | void CuSuiteFree(CuSuite *testsuite); 88 | 89 | #endif /* CU_TEST_H */ 90 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /core/contrib.c: -------------------------------------------------------------------------------- 1 | // 2 | // contrib.c 3 | // stuff written by other folks, seen on blogs, etc. 4 | // 5 | #include 6 | #include 7 | #include 8 | #include "config.h" 9 | 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 | #define ONEMASK ((size_t)(-1) / 0xFF) 17 | 18 | size_t 19 | potion_cp_strlen_utf8(const char * _s) 20 | { 21 | const char * s; 22 | size_t count = 0; 23 | size_t u; 24 | unsigned char b; 25 | 26 | for (s = _s; (uintptr_t)(s) & (sizeof(size_t) - 1); s++) { 27 | b = *s; 28 | if (b == '\0') goto done; 29 | count += (b >> 7) & ((~b) >> 6); 30 | } 31 | 32 | for (; ; s += sizeof(size_t)) { 33 | __builtin_prefetch(&s[256], 0, 0); 34 | u = *(size_t *)(s); 35 | if ((u - ONEMASK) & (~u) & (ONEMASK * 0x80)) break; 36 | u = ((u & (ONEMASK * 0x80)) >> 7) & ((~u) >> 6); 37 | count += (u * ONEMASK) >> ((sizeof(size_t) - 1) * 8); 38 | } 39 | 40 | for (; ; s++) { 41 | b = *s; 42 | if (b == '\0') break; 43 | count += (b >> 7) & ((~b) >> 6); 44 | } 45 | done: 46 | return ((s - _s) - count); 47 | } 48 | 49 | #ifdef __MINGW32__ 50 | #include 51 | #include 52 | 53 | void *potion_mmap(size_t length, const char exec) 54 | { 55 | void *mem = VirtualAlloc(NULL, length, MEM_COMMIT, 56 | exec ? PAGE_EXECUTE_READWRITE : PAGE_READWRITE); 57 | if (mem == NULL) 58 | fprintf(stderr, "** potion_mmap failed"); 59 | return mem; 60 | } 61 | 62 | int potion_munmap(void *mem, size_t len) 63 | { 64 | return VirtualFree(mem, len, MEM_DECOMMIT) != 0 ? 0 : -1; 65 | } 66 | 67 | #else 68 | #include 69 | 70 | void *potion_mmap(size_t length, const char exec) 71 | { 72 | int prot = exec ? PROT_EXEC : 0; 73 | void *mem = mmap(NULL, length, prot|PROT_READ|PROT_WRITE, 74 | (MAP_PRIVATE|MAP_ANON), -1, 0); 75 | if (mem == MAP_FAILED) return NULL; 76 | return mem; 77 | } 78 | 79 | int potion_munmap(void *mem, size_t len) 80 | { 81 | return munmap(mem, len); 82 | } 83 | 84 | #endif 85 | 86 | #if POTION_WIN32 87 | // vasprintf from nokogiri 88 | // http://github.com/tenderlove/nokogiri 89 | // (written by Geoffroy Couprie) 90 | int vasprintf (char **strp, const char *fmt, va_list ap) 91 | { 92 | int len = vsnprintf (NULL, 0, fmt, ap) + 1; 93 | char *res = (char *)malloc((unsigned int)len); 94 | if (res == NULL) 95 | return -1; 96 | *strp = res; 97 | return vsnprintf(res, (unsigned int)len, fmt, ap); 98 | } 99 | 100 | // asprintf from glibc 101 | int 102 | asprintf (char **string_ptr, const char *format, ...) 103 | { 104 | va_list arg; 105 | int done; 106 | 107 | va_start (arg, format); 108 | done = vasprintf (string_ptr, format, arg); 109 | va_end (arg); 110 | 111 | return done; 112 | } 113 | #endif 114 | -------------------------------------------------------------------------------- /dist.mak: -------------------------------------------------------------------------------- 1 | # -*- makefile -*- 2 | include config.inc 3 | 4 | SUDO = sudo 5 | 6 | ifeq (${PREFIX},) 7 | $(error need to make config first) 8 | endif 9 | ifeq (${DLL},) 10 | $(error need to make config first) 11 | endif 12 | 13 | VERSION = $(shell ./tools/config.sh "${CC}" version) 14 | PLATFORM = $(shell ./tools/config.sh "${CC}" target) 15 | RELEASE ?= ${VERSION}.${REVISION} 16 | PKG = potion-${RELEASE} 17 | PKGBIN = ${PKG}-${PLATFORM} 18 | 19 | dist: bin-dist src-dist 20 | 21 | release: dist 22 | 23 | install: bin-dist 24 | ${SUDO} tar xfz pkg/${PKGBIN}.tar.gz -C $(PREFIX)/ 25 | 26 | bin-dist: pkg/${PKGBIN}.tar.gz pkg/${PKGBIN}-devel.tar.gz 27 | 28 | pkg/${PKGBIN}.tar.gz: core/config.h core/version.h core/syntax.c potion${EXE} \ 29 | libpotion.a libpotion${DLL} lib/readline${LOADEXT} 30 | rm -rf dist 31 | mkdir -p dist dist/bin dist/include/potion dist/lib/potion dist/share/potion/doc \ 32 | dist/share/potion/example 33 | cp potion${EXE} dist/bin/ 34 | cp libpotion.a dist/lib/ 35 | cp libpotion${DLL} dist/lib/ 36 | if [ ${WIN32} = 1 ]; then mv dist/lib/*.dll dist/bin/; fi 37 | cp lib/readline${LOADEXT} dist/lib/potion/ 38 | cp core/potion.h dist/include/potion/ 39 | cp core/config.h dist/include/potion/ 40 | -cp doc/*.html doc/*.png dist/share/potion/doc/ 41 | -cp doc/core-files.txt dist/share/potion/doc/ 42 | -cp README COPYING LICENSE dist/share/potion/doc/ 43 | cp example/* dist/share/potion/example/ 44 | -mkdir -p pkg 45 | (cd dist && tar czf ../pkg/${PKGBIN}.tar.gz * && cd ..) 46 | rm -rf dist 47 | 48 | pkg/${PKGBIN}-devel.tar.gz: tools/greg${EXE} potion-s${EXE} 49 | +${MAKE} GTAGS 50 | rm -rf dist 51 | mkdir -p dist dist/bin dist/include/potion dist/lib/potion \ 52 | dist/share/potion/doc/ref 53 | cp tools/greg${EXE} dist/bin/ 54 | cp potion-s${EXE} dist/bin/ 55 | cp core/*.h dist/include/potion/ 56 | rm dist/include/potion/potion.h dist/include/potion/config.h 57 | -cp -r doc/*.textile doc/html dist/share/potion/doc/ 58 | -cp -r doc/latex I*.md dist/share/potion/doc/ 59 | -cp -r HTML/* dist/share/potion/doc/ref/ 60 | -mkdir -p pkg 61 | (cd dist && tar czf ../pkg/${PKGBIN}-devel.tar.gz * && cd ..) 62 | rm -rf dist 63 | 64 | src-dist: pkg/${PKG}-src.tar.gz 65 | 66 | pkg/${PKG}-src.tar.gz: tarball 67 | 68 | tarball: core/version.h core/syntax.c 69 | -mkdir -p pkg 70 | rm -rf ${PKG} 71 | git checkout-index --prefix=${PKG}/ -a 72 | rm -f ${PKG}/.gitignore 73 | cp core/version.h ${PKG}/core/ 74 | cp core/syntax.c ${PKG}/core/ 75 | tar czf pkg/${PKG}-src.tar.gz ${PKG} 76 | rm -rf ${PKG} 77 | 78 | GTAGS: ${SRC} core/*.h 79 | rm -rf ${PKG} HTML 80 | git checkout-index --prefix=${PKG}/ -a 81 | -cp core/version.h ${PKG}/core/ 82 | cd ${PKG} && \ 83 | mv tools/greg.c tools/greg-c.tmp && \ 84 | gtags && htags && \ 85 | sed -e's,background-color: #f5f5dc,background-color: #ffffff,' < HTML/style.css > HTML/style.new && \ 86 | mv HTML/style.new HTML/style.css && \ 87 | mv tools/greg-c.tmp tools/greg.c && \ 88 | cd .. && \ 89 | mv ${PKG}/HTML . 90 | rm -rf ${PKG} 91 | 92 | .PHONY: dist release install tarball src-dist bin-dist 93 | -------------------------------------------------------------------------------- /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 | void gc_test_start(CuTest *T) { 20 | CuAssert(T, "GC struct isn't at start of first page", P->mem == P->mem->birth_lo); 21 | CuAssert(T, "stack length is not a positive number", potion_stack_len(P, NULL) > 0); 22 | } 23 | 24 | // 25 | // everything allocated in alloc1 and alloc4 tests goes out of scope, so will 26 | // not be moved to the old generation. data in the `forward` test will be copied. 27 | // 28 | void gc_test_alloc1(CuTest *T) { 29 | PN ptr = (PN)potion_gc_alloc(P, PN_TUSER, 16); 30 | PN_SIZE count = potion_mark_stack(P, 0); 31 | CuAssert(T, "couldn't allocate 16 bytes from GC", PN_IS_PTR(ptr)); 32 | CuAssert(T, "only one or two allocations should be found", count >= 1 && count <= 2); 33 | } 34 | 35 | void gc_test_alloc4(CuTest *T) { 36 | PN ptr = (PN)potion_gc_alloc(P, PN_TUSER, 16); 37 | PN ptr2 = (PN)potion_gc_alloc(P, PN_TUSER, 16); 38 | PN ptr3 = (PN)potion_gc_alloc(P, PN_TUSER, 16); 39 | PN ptr4 = (PN)potion_gc_alloc(P, PN_TUSER, 16); 40 | PN_SIZE count = potion_mark_stack(P, 0); 41 | CuAssert(T, "couldn't allocate 16 bytes from GC", PN_IS_PTR(ptr)); 42 | CuAssert(T, "couldn't allocate 16 bytes from GC", PN_IS_PTR(ptr2)); 43 | CuAssert(T, "couldn't allocate 16 bytes from GC", PN_IS_PTR(ptr3)); 44 | CuAssert(T, "couldn't allocate 16 bytes from GC", PN_IS_PTR(ptr4)); 45 | CuAssert(T, "min. four allocations should be found", count >= 4); 46 | } 47 | 48 | void gc_test_forward(CuTest *T) { 49 | char *fj = "frances johnson."; 50 | vPN(Data) ptr = potion_data_alloc(P, 16); 51 | register unsigned long old = (PN)ptr & 0xFFFF; 52 | memcpy(ptr->data, fj, 16); 53 | 54 | potion_mark_stack(P, 1); 55 | CuAssert(T, "copied location identical to original", (old & 0xFFFF) != (PN)ptr); 56 | CuAssertIntEquals(T, "copied object not still PN_TUSER", ptr->vt, PN_TUSER); 57 | CuAssert(T, "copied data not identical to original", 58 | strncmp(ptr->data, fj, 16) == 0); 59 | } 60 | 61 | CuSuite *gc_suite() { 62 | CuSuite *S = CuSuiteNew(); 63 | SUITE_ADD_TEST(S, gc_test_start); 64 | SUITE_ADD_TEST(S, gc_test_alloc1); 65 | SUITE_ADD_TEST(S, gc_test_alloc4); 66 | SUITE_ADD_TEST(S, gc_test_forward); 67 | return S; 68 | } 69 | 70 | int main(void) { 71 | POTION_INIT_STACK(sp); 72 | int count; 73 | 74 | // manually initialize the older generation 75 | P = potion_gc_boot(sp); 76 | if (P->mem->old_lo == NULL) { 77 | struct PNMemory *M = P->mem; 78 | int gensz = POTION_BIRTH_SIZE * 2; 79 | void *page = pngc_page_new(&gensz, 0); 80 | SET_GEN(old, page, gensz); 81 | } 82 | 83 | CuString *out = CuStringNew(); 84 | CuSuite *suite = gc_suite(); 85 | CuSuiteRun(suite); 86 | CuSuiteSummary(suite, out); 87 | CuSuiteDetails(suite, out); 88 | printf("%s\n", out->buffer); 89 | count = suite->failCount; 90 | CuSuiteFree(suite); 91 | CuStringFree(out); 92 | return count; 93 | } 94 | -------------------------------------------------------------------------------- /core/vm-dis.c: -------------------------------------------------------------------------------- 1 | #if defined(JIT_DEBUG) 2 | printf("-- jit --\n"); 3 | printf("; function definition: %p ; %u bytes\n", asmb->ptr, asmb->len); 4 | # if defined(HAVE_LIBUDIS86) && (POTION_JIT_TARGET == POTION_X86) 5 | { 6 | ud_t ud_obj; 7 | 8 | ud_init(&ud_obj); 9 | ud_set_input_buffer(&ud_obj, asmb->ptr, asmb->len); 10 | ud_set_mode(&ud_obj, __WORDSIZE == 64 ? 64 : 32); 11 | ud_set_syntax(&ud_obj, UD_SYN_ATT); 12 | 13 | while (ud_disassemble(&ud_obj)) { 14 | printf("0x%lx\t%s\n", (long)ud_insn_off(&ud_obj), ud_insn_asm(&ud_obj)); 15 | } 16 | } 17 | # else 18 | # if defined(HAVE_LIBDISTORM64) && (POTION_JIT_TARGET == POTION_X86) 19 | { 20 | #define MAX_INSTRUCTIONS 2048 21 | #define MAX_TEXT_SIZE (60) 22 | typedef enum {Decode16Bits = 0, Decode32Bits = 1, Decode64Bits = 2} _DecodeType; 23 | typedef enum {DECRES_NONE, DECRES_SUCCESS, DECRES_MEMORYERR, DECRES_INPUTERR} _DecodeResult; 24 | typedef long _OffsetType; 25 | typedef struct { 26 | unsigned int pos; 27 | int8_t p[MAX_TEXT_SIZE]; 28 | } _WString; 29 | typedef struct { 30 | _WString mnemonic; 31 | _WString operands; 32 | _WString instructionHex; 33 | unsigned int size; 34 | _OffsetType offset; 35 | } _DecodedInst; 36 | _DecodeResult distorm_decode64(_OffsetType, 37 | const unsigned char*, 38 | long, 39 | int, 40 | _DecodedInst*, 41 | int, 42 | unsigned int*); 43 | 44 | _DecodeResult res; 45 | _DecodedInst disassembled[MAX_INSTRUCTIONS]; 46 | unsigned int decodedInstructionsCount = 0; 47 | _OffsetType offset = 0; 48 | int i; 49 | 50 | distorm_decode64(offset, 51 | (const unsigned char*)asmb->ptr, 52 | asmb->len, 53 | __WORDSIZE == 64 ? 2 : 1, 54 | disassembled, 55 | MAX_INSTRUCTIONS, 56 | &decodedInstructionsCount); 57 | for (i = 0; i < decodedInstructionsCount; i++) { 58 | printf("0x%04x (%02d) %-24s %s%s%s\r\n", 59 | disassembled[i].offset, 60 | disassembled[i].size, 61 | (char*)disassembled[i].instructionHex.p, 62 | (char*)disassembled[i].mnemonic.p, 63 | disassembled[i].operands.pos != 0 ? " " : "", 64 | (char*)disassembled[i].operands.p); 65 | } 66 | } 67 | # else 68 | # if defined(HAVE_LIBDISASM) && (POTION_JIT_TARGET == POTION_X86) 69 | # define LINE_SIZE 255 70 | { 71 | char line[LINE_SIZE]; 72 | int pos = 0; 73 | int size = asmb->len; 74 | int insnsize; /* size of instruction */ 75 | x86_insn_t insn; /* one instruction */ 76 | 77 | // only stable for 32bit 78 | x86_init(opt_none, NULL, NULL); 79 | while ( pos < size ) { 80 | insnsize = x86_disasm(asmb->ptr, size, 0, pos, &insn); 81 | if ( insnsize ) { 82 | int i; 83 | x86_format_insn(&insn, line, LINE_SIZE, att_syntax); 84 | printf("0x%x\t", pos); 85 | for ( i = 0; i < 10; i++ ) { 86 | if ( i < insn.size ) printf("%02x", insn.bytes[i]); 87 | else printf(" "); 88 | } 89 | printf("%s\n", line); 90 | pos += insnsize; 91 | } else { 92 | printf("Invalid instruction at 0x%x. size=0x%x\n", pos, size); 93 | pos++; 94 | } 95 | } 96 | x86_cleanup(); 97 | } 98 | #else 99 | long ai = 0; 100 | for (ai = 0; ai < asmb->len; ai++) { 101 | printf("%x ", asmb->ptr[ai]); 102 | } 103 | printf("\n"); 104 | # endif 105 | # endif 106 | # endif 107 | #endif 108 | -------------------------------------------------------------------------------- /core/internal.h: -------------------------------------------------------------------------------- 1 | // 2 | // internal.h 3 | // 4 | // (c) 2008 why the lucky stiff, the freelance professor 5 | // 6 | #ifndef POTION_INTERNAL_H 7 | #define POTION_INTERNAL_H 8 | 9 | struct Potion_State; 10 | 11 | typedef unsigned char u8; 12 | 13 | #define PN_ALLOC(V,T) (T *)potion_gc_alloc(P, V, sizeof(T)) 14 | #define PN_ALLOC_N(V,T,C) (T *)potion_gc_alloc(P, V, sizeof(T)+C) 15 | #define PN_CALLOC_N(V,T,C) (T *)potion_gc_calloc(P, V, sizeof(T)+C) 16 | #define PN_REALLOC(X,V,T,N) (X)=(T *)potion_gc_realloc(P, V, (struct PNObject *)(X), sizeof(T) + N) 17 | #define PN_DALLOC_N(T,N) potion_data_alloc(P, sizeof(T)*N) 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 | 24 | #ifndef min 25 | #define min(a, b) ((a) <= (b) ? (a) : (b)) 26 | #endif 27 | 28 | #ifndef max 29 | #define max(a, b) ((a) >= (b) ? (a) : (b)) 30 | #endif 31 | 32 | #define TYPE_BATCH_SIZE 4096 33 | 34 | #define PN_FLEX_NEW(N, V, T, S) \ 35 | (N) = PN_ALLOC_N(V, T, (sizeof(*(N)->ptr) * S)); \ 36 | (N)->siz = sizeof(*(N)->ptr) * S; \ 37 | (N)->len = 0 38 | 39 | #define PN_FLEX_NEEDS(X, N, V, T, S) ({ \ 40 | PN_SIZE capa = (N)->siz / sizeof(*(N)->ptr); \ 41 | if (capa < (N)->len + X) { \ 42 | while (capa < (N)->len + X) \ 43 | capa += S; \ 44 | capa = sizeof(*(N)->ptr) * capa; \ 45 | PN_REALLOC(N, V, T, capa); \ 46 | (N)->siz = capa; \ 47 | } \ 48 | }) 49 | 50 | #define PN_ATOI(X,N,B) ({ \ 51 | char *Ap = X; \ 52 | long Ai = 0; \ 53 | size_t Al = N; \ 54 | while (Al--) { \ 55 | if ((*Ap >= '0') && (*Ap <= '9')) \ 56 | Ai = (Ai * B) + (*Ap - '0'); \ 57 | else if ((*Ap >= 'A') && (*Ap <= 'F')) \ 58 | Ai = (Ai * B) + ((*Ap - 'A') + 10); \ 59 | else if ((*Ap >= 'a') && (*Ap <= 'f')) \ 60 | Ai = (Ai * B) + ((*Ap - 'a') + 10); \ 61 | else break; \ 62 | Ap++; \ 63 | } \ 64 | Ai; \ 65 | }) 66 | 67 | struct PNBHeader { 68 | u8 sig[4]; 69 | u8 major; 70 | u8 minor; 71 | u8 vmid; 72 | u8 pn; 73 | u8 proto[0]; 74 | }; 75 | 76 | size_t potion_cp_strlen_utf8(const char *); 77 | void *potion_mmap(size_t, const char); 78 | int potion_munmap(void *, size_t); 79 | #if POTION_WIN32 80 | int vasprintf (char **strp, const char *fmt, ...); 81 | int asprintf (char **string_ptr, const char *format, ...); 82 | #endif 83 | #define PN_ALLOC_FUNC(size) potion_mmap(size, 1) 84 | 85 | // 86 | // stack manipulation routines 87 | // 88 | #if POTION_X86 == POTION_JIT_TARGET 89 | #if __WORDSIZE == 64 90 | #define PN_SAVED_REGS 5 91 | #define POTION_ESP(p) __asm__("mov %%rsp, %0" : "=r" (*p)) 92 | #define POTION_EBP(p) __asm__("mov %%rbp, %0" : "=r" (*p)) 93 | #else 94 | #define PN_SAVED_REGS 3 95 | #define POTION_ESP(p) __asm__("mov %%esp, %0" : "=r" (*p)) 96 | #define POTION_EBP(p) __asm__("mov %%ebp, %0" : "=r" (*p)) 97 | #endif 98 | #else 99 | #define PN_SAVED_REGS 0 100 | __attribute__ ((noinline)) void potion_esp(void **); 101 | #define POTION_ESP(p) potion_esp((void **)p) 102 | #define POTION_EBP(p) potion_esp((void **)p) 103 | #endif 104 | 105 | #ifndef O_BINARY 106 | #define O_BINARY 0 107 | #endif 108 | 109 | #if POTION_STACK_DIR > 0 110 | #define STACK_UPPER(a, b) a 111 | #elif POTION_STACK_DIR < 0 112 | #define STACK_UPPER(a, b) b 113 | #endif 114 | 115 | #define GC_PROTECT(P) P->mem->protect = (void *)P->mem->birth_cur 116 | 117 | #endif 118 | -------------------------------------------------------------------------------- /core/asm.h: -------------------------------------------------------------------------------- 1 | // 2 | // asm.h 3 | // some assembler macros 4 | // 5 | // (c) 2008 why the lucky stiff, the freelance professor 6 | // 7 | 8 | // 9 | // PNAsm(vt = PN_TUSER, siz, ptr, len) 10 | // -> PNFlex(vt = PN_TUSER, siz, ...) 11 | // overhead of 6 words on x86, but don't have to 12 | // do constant forwarding tricks. 13 | // 14 | #ifndef POTION_ASM_H 15 | #define POTION_ASM_H 16 | 17 | #define ASM_UNIT 512 18 | 19 | typedef struct { 20 | size_t from; 21 | PN_SIZE to; 22 | } PNJumps; 23 | 24 | #define MAKE_TARGET(arch) PNTarget potion_target_##arch = { \ 25 | .setup = potion_##arch##_setup, \ 26 | .stack = potion_##arch##_stack, \ 27 | .registers = potion_##arch##_registers, \ 28 | .local = potion_##arch##_local, \ 29 | .upvals = potion_##arch##_upvals, \ 30 | .jmpedit = potion_##arch##_jmpedit, \ 31 | .op = { \ 32 | (OP_F)NULL, \ 33 | (OP_F)potion_##arch##_move, \ 34 | (OP_F)potion_##arch##_loadk, \ 35 | (OP_F)potion_##arch##_loadpn, \ 36 | (OP_F)potion_##arch##_self, \ 37 | (OP_F)potion_##arch##_newtuple, \ 38 | (OP_F)potion_##arch##_settuple, \ 39 | (OP_F)potion_##arch##_getlocal, \ 40 | (OP_F)potion_##arch##_setlocal, \ 41 | (OP_F)potion_##arch##_getupval, \ 42 | (OP_F)potion_##arch##_setupval, \ 43 | (OP_F)potion_##arch##_global, \ 44 | (OP_F)NULL, \ 45 | (OP_F)potion_##arch##_settable, \ 46 | (OP_F)potion_##arch##_newlick, \ 47 | (OP_F)potion_##arch##_getpath, \ 48 | (OP_F)potion_##arch##_setpath, \ 49 | (OP_F)potion_##arch##_add, \ 50 | (OP_F)potion_##arch##_sub, \ 51 | (OP_F)potion_##arch##_mult, \ 52 | (OP_F)potion_##arch##_div, \ 53 | (OP_F)potion_##arch##_rem, \ 54 | (OP_F)potion_##arch##_pow, \ 55 | (OP_F)potion_##arch##_not, \ 56 | (OP_F)potion_##arch##_cmp, \ 57 | (OP_F)potion_##arch##_eq, \ 58 | (OP_F)potion_##arch##_neq, \ 59 | (OP_F)potion_##arch##_lt, \ 60 | (OP_F)potion_##arch##_lte, \ 61 | (OP_F)potion_##arch##_gt, \ 62 | (OP_F)potion_##arch##_gte, \ 63 | (OP_F)potion_##arch##_bitn, \ 64 | (OP_F)potion_##arch##_bitl, \ 65 | (OP_F)potion_##arch##_bitr, \ 66 | (OP_F)potion_##arch##_def, \ 67 | (OP_F)potion_##arch##_bind, \ 68 | (OP_F)potion_##arch##_message, \ 69 | (OP_F)potion_##arch##_jmp, \ 70 | (OP_F)potion_##arch##_test, \ 71 | (OP_F)potion_##arch##_testjmp, \ 72 | (OP_F)potion_##arch##_notjmp, \ 73 | (OP_F)potion_##arch##_named, \ 74 | (OP_F)potion_##arch##_call, \ 75 | (OP_F)potion_##arch##_callset, \ 76 | (OP_F)NULL, \ 77 | (OP_F)potion_##arch##_return, \ 78 | (OP_F)potion_##arch##_method, \ 79 | (OP_F)potion_##arch##_class \ 80 | }, \ 81 | .finish = potion_##arch##_finish, \ 82 | .mcache = potion_##arch##_mcache, \ 83 | .ivars = potion_##arch##_ivars \ 84 | } 85 | 86 | #define PN_HAS_UPVALS(v) \ 87 | int v = 0; \ 88 | if (PN_TUPLE_LEN(f->protos) > 0) { \ 89 | PN_TUPLE_EACH(f->protos, i, proto2, { \ 90 | if (PN_TUPLE_LEN(PN_PROTO(proto2)->upvals) > 0) { \ 91 | v = 1; \ 92 | } \ 93 | }); \ 94 | } 95 | 96 | #define ASM(ins) *asmp = potion_asm_put(P, *asmp, (PN)(ins), sizeof(u8)) 97 | #define ASM2(pn) *asmp = potion_asm_put(P, *asmp, (PN)(pn), 2) 98 | #define ASMI(pn) *asmp = potion_asm_put(P, *asmp, (PN)(pn), sizeof(int)) 99 | #define ASMN(pn) *asmp = potion_asm_put(P, *asmp, (PN)(pn), sizeof(PN)) 100 | 101 | PNAsm *potion_asm_new(Potion *); 102 | PNAsm *potion_asm_clear(Potion *, PNAsm *); 103 | PNAsm *potion_asm_put(Potion *, PNAsm *, PN, size_t); 104 | PNAsm *potion_asm_op(Potion *, PNAsm *, u8, int, int); 105 | PNAsm *potion_asm_write(Potion *, PNAsm *, char *, size_t); 106 | 107 | #endif 108 | -------------------------------------------------------------------------------- /core/callcc.c: -------------------------------------------------------------------------------- 1 | // 2 | // callcc.c 3 | // creation and calling of continuations 4 | // 5 | // NOTE: these hacks make use of the frame pointer, so they must 6 | // be compiled -fno-omit-frame-pointer! 7 | // 8 | // (c) 2008 why the lucky stiff, the freelance professor 9 | // 10 | #include 11 | #include "potion.h" 12 | #include "internal.h" 13 | 14 | PN potion_continuation_yield(Potion *P, PN cl, PN self) { 15 | struct PNCont *cc = (struct PNCont *)self; 16 | PN *start, *end, *sp1 = P->mem->cstack; 17 | #if POTION_STACK_DIR > 0 18 | start = (PN *)cc->stack[0]; 19 | end = (PN *)cc->stack[1]; 20 | #else 21 | start = (PN *)cc->stack[1]; 22 | end = (PN *)cc->stack[0]; 23 | #endif 24 | 25 | if ((PN)sp1 != cc->stack[0]) { 26 | fprintf(stderr, "** TODO: continuations which switch stacks must be rewritten. (%p != %p)\n", 27 | sp1, (void *)(cc->stack[0])); 28 | return PN_NIL; 29 | } 30 | 31 | // 32 | // move stack pointer, fill in stack, resume 33 | // 34 | cc->stack[3] = (PN)cc; 35 | #if POTION_X86 == POTION_JIT_TARGET 36 | #if __WORDSIZE == 64 37 | __asm__ ("mov 0x8(%2), %%rsp;" 38 | "mov 0x10(%2), %%rbp;" 39 | "mov %2, %%rbx;" 40 | "add $0x48, %2;" 41 | "loop:" 42 | "mov (%2), %%rax;" 43 | "add $0x8, %0;" 44 | "mov %%rax, (%0);" 45 | "add $0x8, %2;" 46 | "cmp %0, %1;" 47 | "jne loop;" 48 | "mov 0x18(%%rbx), %%rax;" 49 | "movq $0x0, 0x18(%%rbx);" 50 | "mov 0x28(%%rbx), %%r12;" 51 | "mov 0x30(%%rbx), %%r13;" 52 | "mov 0x38(%%rbx), %%r14;" 53 | "mov 0x40(%%rbx), %%r15;" 54 | "mov 0x20(%%rbx), %%rbx;" 55 | "leave; ret" 56 | :/* no output */ 57 | :"r"(start), "r"(end), "r"(cc->stack) 58 | :"%rax", "%rsp", "%rbx" 59 | ); 60 | #else 61 | __asm__ ("mov 0x4(%2), %%esp;" 62 | "mov 0x8(%2), %%ebp;" 63 | "mov %2, %%esi;" 64 | "add $0x1c, %2;" 65 | "loop:" 66 | "mov (%2), %%eax;" 67 | "add $0x4, %0;" 68 | "mov %%eax, (%0);" 69 | "add $0x4, %2;" 70 | "cmp %0, %1;" 71 | "jne loop;" 72 | "mov 0xc(%%esi), %%eax;" 73 | "mov 0x14(%%esi), %%edi;" 74 | "mov 0x18(%%esi), %%ebx;" 75 | "mov 0x10(%%esi), %%esi;" 76 | "leave; ret" 77 | :/* no output */ 78 | :"r"(start), "r"(end), "r"(cc->stack) 79 | :"%eax", "%esp", /*"%ebp",*/ "%esi" 80 | ); 81 | #endif 82 | #else 83 | fprintf(stderr, "** TODO: callcc/yield does not work outside of X86 yet.\n"); 84 | #endif 85 | return self; 86 | } 87 | 88 | ATTRIBUTE_NO_ADDRESS_SAFETY_ANALYSIS 89 | PN potion_callcc(Potion *P, PN cl, PN self) { 90 | struct PNCont *cc; 91 | PN_SIZE n; 92 | PN *start, *sp1 = P->mem->cstack, *sp2, *sp3; 93 | POTION_ESP(&sp2); 94 | POTION_EBP(&sp3); 95 | #if POTION_STACK_DIR > 0 96 | n = sp2 - sp1; 97 | start = sp1; 98 | #else 99 | n = sp1 - sp2 + 1; 100 | start = sp2; 101 | #endif 102 | 103 | cc = PN_ALLOC_N(PN_TCONT, struct PNCont, sizeof(PN) * (n + 3 + PN_SAVED_REGS)); 104 | cc->len = n + 3; 105 | cc->stack[0] = (PN)sp1; 106 | cc->stack[1] = (PN)sp2; 107 | cc->stack[2] = (PN)sp3; 108 | cc->stack[3] = PN_NIL; 109 | #if POTION_X86 == POTION_JIT_TARGET 110 | #if __WORDSIZE == 64 111 | __asm__ ("mov %%rbx, 0x20(%0);" 112 | "mov %%r12, 0x28(%0);" 113 | "mov %%r13, 0x30(%0);" 114 | "mov %%r14, 0x38(%0);" 115 | "mov %%r15, 0x40(%0);"::"r"(cc->stack)); 116 | #else 117 | __asm__ ("mov %%esi, 0x10(%0);" 118 | "mov %%edi, 0x14(%0);" 119 | "mov %%ebx, 0x18(%0)"::"r"(cc->stack)); 120 | #endif 121 | #endif 122 | 123 | // avoid wrong asan stack underflow, caught in memcpy 124 | #if defined(__clang__) && defined(__SANITIZE_ADDRESS__) 125 | { 126 | PN *s = start + 1; 127 | PN *d = cc->stack + 4 + PN_SAVED_REGS; 128 | for (int i=0; i < n - 1; i++) { 129 | *d++ = *s++; 130 | } 131 | } 132 | #else 133 | PN_MEMCPY_N((char *)(cc->stack + 4 + PN_SAVED_REGS), start + 1, PN, n - 1); 134 | #endif 135 | return (PN)cc; 136 | } 137 | 138 | void potion_cont_init(Potion *P) { 139 | PN cnt_vt = PN_VTABLE(PN_TCONT); 140 | potion_type_call_is(cnt_vt, PN_FUNC(potion_continuation_yield, 0)); 141 | } 142 | 143 | -------------------------------------------------------------------------------- /core/file.c: -------------------------------------------------------------------------------- 1 | // 2 | // file.c 3 | // working with file descriptors 4 | // 5 | // (c) 2008 why the lucky stiff, the freelance professor 6 | // 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include 12 | #include "potion.h" 13 | #include "internal.h" 14 | #include "table.h" 15 | 16 | #ifdef __APPLE__ 17 | # include 18 | # undef environ 19 | # define environ (*_NSGetEnviron()) 20 | #else 21 | extern char **environ; 22 | #endif 23 | 24 | typedef vPN(File) pn_file; 25 | 26 | PN potion_file_new(Potion *P, PN cl, PN self, PN path, PN modestr) { 27 | int fd; 28 | mode_t mode; 29 | if (strcmp(PN_STR_PTR(modestr), "r") == 0) { 30 | mode = O_RDONLY; 31 | } else if (strcmp(PN_STR_PTR(modestr), "r+") == 0) { 32 | mode = O_RDWR; 33 | } else if (strcmp(PN_STR_PTR(modestr), "w") == 0) { 34 | mode = O_WRONLY | O_TRUNC | O_CREAT; 35 | } else if (strcmp(PN_STR_PTR(modestr), "w+") == 0) { 36 | mode = O_RDWR | O_TRUNC | O_CREAT; 37 | } else if (strcmp(PN_STR_PTR(modestr), "a") == 0) { 38 | mode = O_WRONLY | O_CREAT | O_APPEND; 39 | } else if (strcmp(PN_STR_PTR(modestr), "a+") == 0) { 40 | mode = O_RDWR | O_CREAT | O_APPEND; 41 | } else { 42 | // invalid mode 43 | return PN_NIL; 44 | } 45 | if ((fd = open(PN_STR_PTR(path), mode, 0755)) == -1) { 46 | perror("open"); 47 | // TODO: error 48 | return PN_NIL; 49 | } 50 | ((struct PNFile *)self)->fd = fd; 51 | ((struct PNFile *)self)->path = path; 52 | ((struct PNFile *)self)->mode = mode; 53 | return self; 54 | } 55 | 56 | PN potion_file_with_fd(Potion *P, PN cl, PN self, PN fd) { 57 | struct PNFile *file = (struct PNFile *)potion_object_new(P, PN_NIL, PN_VTABLE(PN_TFILE)); 58 | file->fd = PN_INT(fd); 59 | file->path = PN_NIL; 60 | #ifdef F_GETFL 61 | file->mode = fcntl(file->fd, F_GETFL) | O_ACCMODE; 62 | #else 63 | struct stat st; 64 | if (fstat(file->fd, &st) == -1) perror("fstat"); 65 | file->mode = st.st_mode; 66 | #endif 67 | return (PN)file; 68 | } 69 | 70 | PN potion_file_close(Potion *P, PN cl, pn_file self) { 71 | close(self->fd); 72 | self->fd = -1; 73 | return PN_NIL; 74 | } 75 | 76 | PN potion_file_read(Potion *P, PN cl, pn_file self, PN n) { 77 | n = PN_INT(n); 78 | char buf[n]; 79 | int r = read(self->fd, buf, n); 80 | if (r == -1) { 81 | perror("read"); 82 | // TODO: error 83 | return PN_NUM(-1); 84 | } else if (r == 0) { 85 | return PN_NIL; 86 | } 87 | return potion_byte_str2(P, buf, r); 88 | } 89 | 90 | PN potion_file_write(Potion *P, PN cl, pn_file self, PN str) { 91 | int r = write(self->fd, PN_STR_PTR(str), PN_STR_LEN(str)); 92 | if (r == -1) { 93 | perror("write"); 94 | // TODO: error 95 | return PN_NIL; 96 | } 97 | return PN_NUM(r); 98 | } 99 | 100 | PN potion_file_string(Potion *P, PN cl, pn_file self) { 101 | int fd = self->fd, rv; 102 | char *buf; 103 | PN str; 104 | if (self->path != PN_NIL && fd != -1) { 105 | rv = asprintf(&buf, "", PN_STR_PTR(self->path), fd); 106 | } else if (fd != -1) { 107 | rv = asprintf(&buf, "", fd); 108 | } else { 109 | rv = asprintf(&buf, ""); 110 | } 111 | if (rv == -1) potion_allocation_error(); 112 | str = potion_str(P, buf); 113 | free(buf); 114 | return str; 115 | } 116 | 117 | PN potion_lobby_read(Potion *P, PN cl, PN self) { 118 | const int linemax = 1024; 119 | char line[linemax]; 120 | if (fgets(line, linemax, stdin) != NULL) 121 | return potion_str(P, line); 122 | return PN_NIL; 123 | } 124 | 125 | void potion_file_init(Potion *P) { 126 | PN file_vt = PN_VTABLE(PN_TFILE); 127 | char **env = environ, *key; 128 | PN pe = potion_table_empty(P); 129 | while (*env != NULL) { 130 | for (key = *env; *key != '='; key++); 131 | potion_table_put(P, PN_NIL, pe, potion_str2(P, *env, key - *env), 132 | potion_str(P, key + 1)); 133 | env++; 134 | } 135 | potion_send(P->lobby, PN_def, potion_str(P, "Env"), pe); 136 | potion_method(P->lobby, "read", potion_lobby_read, 0); 137 | 138 | potion_type_constructor_is(file_vt, PN_FUNC(potion_file_new, "path=S,mode=S")); 139 | potion_class_method(file_vt, "fd", potion_file_with_fd, "fd=N"); 140 | potion_method(file_vt, "string", potion_file_string, 0); 141 | potion_method(file_vt, "close", potion_file_close, 0); 142 | potion_method(file_vt, "read", potion_file_read, "n=N"); 143 | potion_method(file_vt, "write", potion_file_write, "str=S"); 144 | } 145 | -------------------------------------------------------------------------------- /tools/greg.h: -------------------------------------------------------------------------------- 1 | /* Copyright (c) 2007 by Ian Piumarta 2 | * All rights reserved. 3 | * 4 | * Permission is hereby granted, free of charge, to any person obtaining a 5 | * copy of this software and associated documentation files (the 'Software'), 6 | * to deal in the Software without restriction, including without limitation 7 | * the rights to use, copy, modify, merge, publish, distribute, and/or sell 8 | * copies of the Software, and to permit persons to whom the Software is 9 | * furnished to do so, provided that the above copyright notice(s) and this 10 | * permission notice appear in all copies of the Software. Acknowledgement 11 | * of the use of this Software in supporting documentation would be 12 | * appreciated but is not required. 13 | * 14 | * THE SOFTWARE IS PROVIDED 'AS IS'. USE ENTIRELY AT YOUR OWN RISK. 15 | * 16 | * Last edited: 2007-05-15 10:32:05 by piumarta on emilia 17 | */ 18 | 19 | #include 20 | 21 | #define GREG_MAJOR 0 22 | #define GREG_MINOR 3 23 | #define GREG_LEVEL 0 24 | 25 | enum { Unknown= 0, Rule, Variable, Name, Dot, Character, String, Class, Action, Predicate, Alternate, Sequence, PeekFor, PeekNot, Query, Star, Plus }; 26 | 27 | enum { 28 | RuleUsed = 1<<0, 29 | RuleReached = 1<<1, 30 | }; 31 | 32 | typedef union Node Node; 33 | 34 | struct Rule { int type; Node *next; char *name; Node *variables; Node *expression; int id; int flags; }; 35 | struct Variable { int type; Node *next; char *name; Node *value; int offset; }; 36 | struct Name { int type; Node *next; Node *rule; Node *variable; }; 37 | struct Dot { int type; Node *next; }; 38 | struct Character { int type; Node *next; char *value; }; 39 | struct String { int type; Node *next; char *value; }; 40 | struct Class { int type; Node *next; unsigned char *value; }; 41 | struct Action { int type; Node *next; char *text; Node *list; char *name; Node *rule; }; 42 | struct Predicate { int type; Node *next; char *text; }; 43 | struct Alternate { int type; Node *next; Node *first; Node *last; }; 44 | struct Sequence { int type; Node *next; Node *first; Node *last; }; 45 | struct PeekFor { int type; Node *next; Node *element; }; 46 | struct PeekNot { int type; Node *next; Node *element; }; 47 | struct Query { int type; Node *next; Node *element; }; 48 | struct Star { int type; Node *next; Node *element; }; 49 | struct Plus { int type; Node *next; Node *element; }; 50 | struct Any { int type; Node *next; }; 51 | 52 | union Node 53 | { 54 | int type; 55 | struct Rule rule; 56 | struct Variable variable; 57 | struct Name name; 58 | struct Dot dot; 59 | struct Character character; 60 | struct String string; 61 | struct Class cclass; 62 | struct Action action; 63 | struct Predicate predicate; 64 | struct Alternate alternate; 65 | struct Sequence sequence; 66 | struct PeekFor peekFor; 67 | struct PeekNot peekNot; 68 | struct Query query; 69 | struct Star star; 70 | struct Plus plus; 71 | struct Any any; 72 | }; 73 | 74 | extern Node *actions; 75 | extern Node *rules; 76 | extern Node *start; 77 | 78 | extern int ruleCount; 79 | 80 | extern FILE *output; 81 | 82 | extern Node *makeRule(char *name, int starts); 83 | extern Node *findRule(char *name, int starts); 84 | extern Node *beginRule(Node *rule); 85 | extern void Rule_setExpression(Node *rule, Node *expression); 86 | extern Node *Rule_beToken(Node *rule); 87 | extern Node *makeVariable(char *name); 88 | extern Node *makeName(Node *rule); 89 | extern Node *makeDot(void); 90 | extern Node *makeCharacter(char *text); 91 | extern Node *makeString(char *text); 92 | extern Node *makeClass(char *text); 93 | extern Node *makeAction(char *text); 94 | extern Node *makePredicate(char *text); 95 | extern Node *makeAlternate(Node *e); 96 | extern Node *Alternate_append(Node *e, Node *f); 97 | extern Node *makeSequence(Node *e); 98 | extern Node *Sequence_append(Node *e, Node *f); 99 | extern Node *makePeekFor(Node *e); 100 | extern Node *makePeekNot(Node *e); 101 | extern Node *makeQuery(Node *e); 102 | extern Node *makeStar(Node *e); 103 | extern Node *makePlus(Node *e); 104 | extern Node *push(Node *node); 105 | extern Node *top(void); 106 | extern Node *pop(void); 107 | 108 | extern void Rule_compile_c_header(void); 109 | extern void Rule_compile_c(Node *node); 110 | 111 | extern void Node_print(Node *node); 112 | extern void Rule_print(Node *node); 113 | -------------------------------------------------------------------------------- /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 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 | vPN(Object) x; 50 | PN l, r; 51 | if (depth <= 0) 52 | return ALLOC_NODE(); 53 | 54 | l = gc_make_tree(depth - 1, PN_left, PN_right); 55 | r = gc_make_tree(depth - 1, PN_left, PN_right); 56 | x = ALLOC_NODE(); 57 | potion_obj_set(P, PN_NIL, (PN)x, PN_left, l); 58 | potion_obj_set(P, PN_NIL, (PN)x, PN_right, r); 59 | return (PN)x; 60 | } 61 | 62 | PN gc_populate_tree(PN node, int depth, PN PN_left, PN PN_right) { 63 | if (depth <= 0) 64 | return; 65 | 66 | depth--; 67 | potion_obj_set(P, PN_NIL, node, PN_left, ALLOC_NODE()); 68 | PN_TOUCH(node); 69 | #ifdef HOLES 70 | n = ALLOC_NODE(); 71 | #endif 72 | potion_obj_set(P, PN_NIL, node, PN_right, ALLOC_NODE()); 73 | PN_TOUCH(node); 74 | #ifdef HOLES 75 | n = ALLOC_NODE(); 76 | #endif 77 | gc_populate_tree(potion_obj_get(P, PN_NIL, node, PN_left), depth, PN_left, PN_right); 78 | gc_populate_tree(potion_obj_get(P, PN_NIL, node, PN_right), depth, PN_left, PN_right); 79 | } 80 | 81 | int gc_tree_depth(PN node, int side, int depth) { 82 | PN n = ((struct PNObject *)node)->ivars[side]; 83 | if (n == PN_NIL) return depth; 84 | return gc_tree_depth(n, side, depth + 1); 85 | } 86 | 87 | int tree_size(int i) { 88 | return ((1 << (i + 1)) - 1); 89 | } 90 | 91 | int main(void) { 92 | POTION_INIT_STACK(sp); 93 | PN klass, ary, temp, long_lived, PN_left, PN_right; 94 | int i, j, count; 95 | 96 | P = potion_create(sp); 97 | ary = potion_tuple_with_size(P, 2); 98 | PN_TUPLE_AT(ary, 0) = PN_left = potion_str(P, "left"); 99 | PN_TUPLE_AT(ary, 1) = PN_right = potion_str(P, "right"); 100 | klass = potion_class(P, PN_NIL, P->lobby, ary); 101 | tree_type = ((struct PNVtable *)klass)->type; 102 | 103 | printf("Stretching memory with a binary tree of depth %d\n", 104 | tree_stretch); 105 | temp = gc_make_tree(tree_stretch, PN_left, PN_right); 106 | temp = 0; 107 | 108 | printf("Creating a long-lived binary tree of depth %d\n", 109 | tree_long_lived); 110 | long_lived = ALLOC_NODE(); 111 | gc_populate_tree(long_lived, tree_long_lived, PN_left, PN_right); 112 | 113 | printf("Creating a long-lived array of %d doubles\n", 114 | array_size); 115 | ary = potion_tuple_with_size(P, array_size); 116 | for (i = 0; i < array_size / 2; ++i) 117 | PN_TUPLE_AT(ary, i) = PN_NUM(1.0 / i); 118 | 119 | for (i = min_tree; i <= max_tree; i += 2) { 120 | long start, finish; 121 | int iter = 2 * tree_size(tree_stretch) / tree_size(i); 122 | printf ("Creating %d trees of depth %d\n", iter, i); 123 | 124 | start = current_time(); 125 | for (j = 0; j < iter; ++j) { 126 | temp = ALLOC_NODE(); 127 | gc_populate_tree(temp, i, PN_left, PN_right); 128 | } 129 | finish = current_time(); 130 | printf("\tTop down construction took %d msec\n", 131 | finish - start); 132 | 133 | start = current_time(); 134 | for (j = 0; j < iter; ++j) { 135 | temp = gc_make_tree(i, PN_left, PN_right); 136 | temp = 0; 137 | } 138 | finish = current_time(); 139 | printf("\tBottom up construction took %d msec\n", 140 | finish - start); 141 | } 142 | 143 | if (long_lived == 0 || PN_TUPLE_AT(ary, 1000) != PN_NUM(1.0 / 1000)) 144 | printf("Wait, problem.\n"); 145 | 146 | printf ("Total %d minor and %d full garbage collections\n" 147 | " (min.birth.size=%dK, max.size=%dK, gc.thresh=%dK)\n", 148 | P->mem->minors, P->mem->majors, 149 | POTION_BIRTH_SIZE >> 10, POTION_MAX_BIRTH_SIZE >> 10, 150 | POTION_GC_THRESHOLD >> 10); 151 | 152 | potion_destroy(P); 153 | return 0; 154 | } 155 | -------------------------------------------------------------------------------- /test/api/potion-test.c: -------------------------------------------------------------------------------- 1 | // 2 | // potion-test.c 3 | // tests of the Potion C api 4 | // 5 | // (c) 2008 why the lucky stiff, the freelance professor 6 | // 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include "potion.h" 12 | #include "internal.h" 13 | #include "CuTest.h" 14 | 15 | PN num = PN_NUM(490); 16 | Potion *P; 17 | 18 | void potion_test_nil(CuTest *T) { 19 | CuAssert(T, "nil isn't a nil type", PN_TYPE(PN_NIL) == PN_TNIL); 20 | CuAssert(T, "nil is a ref", !PN_IS_PTR(PN_NIL)); 21 | CuAssert(T, "nil nil? is false", 22 | PN_TRUE == potion_send(PN_NIL, potion_str(P, "nil?"))); 23 | } 24 | 25 | void potion_test_bool(CuTest *T) { 26 | CuAssert(T, "true isn't a bool type", PN_TYPE(PN_TRUE) == PN_TBOOLEAN); 27 | CuAssert(T, "true is a ref", !PN_IS_PTR(PN_TRUE)); 28 | CuAssert(T, "false isn't a bool type", PN_TYPE(PN_FALSE) == PN_TBOOLEAN); 29 | CuAssert(T, "false is a ref", !PN_IS_PTR(PN_FALSE)); 30 | } 31 | 32 | void potion_test_int1(CuTest *T) { 33 | PN zero = PN_NUM(0); 34 | CuAssert(T, "zero isn't zero", PN_INT(zero) == 0); 35 | CuAssert(T, "zero isn't a number", PN_IS_NUM(zero)); 36 | CuAssert(T, "zero is a ref", !PN_IS_PTR(zero)); 37 | CuAssert(T, "zero bad add", 38 | 490 == PN_INT(potion_send(zero, potion_str(P, "+"), num))); 39 | } 40 | 41 | void potion_test_int2(CuTest *T) { 42 | PN pos = PN_NUM(10891); 43 | CuAssert(T, "positive numbers invalid", PN_INT(pos) == 10891); 44 | CuAssert(T, "positive not a number", PN_IS_NUM(pos)); 45 | CuAssert(T, "positive is a ref", !PN_IS_PTR(pos)); 46 | CuAssert(T, "positive bad add", 47 | 11381 == PN_INT(potion_send(pos, potion_str(P, "+"), num))); 48 | } 49 | 50 | void potion_test_int3(CuTest *T) { 51 | PN neg = PN_NUM(-4343); 52 | CuAssert(T, "negative numbers invalid", PN_INT(neg) == -4343); 53 | CuAssert(T, "negative not a number", PN_IS_NUM(neg)); 54 | CuAssert(T, "negative is a ref", !PN_IS_PTR(neg)); 55 | CuAssert(T, "negative bad add", 56 | -3853 == PN_INT(potion_send(neg, potion_str(P, "+"), num))); 57 | } 58 | 59 | void potion_test_decimal(CuTest *T) { 60 | PN dec = potion_decimal(P, "14466", 5); 61 | CuAssert(T, "decimal not a number", PN_TYPE(dec) == PN_TNUMBER); 62 | } 63 | 64 | void potion_test_str(CuTest *T) { 65 | CuAssert(T, "string isn't a string", PN_IS_STR(PN_string)); 66 | CuAssert(T, "string isn't a ref", PN_IS_PTR(PN_string)); 67 | CuAssert(T, "string length isn't working", 68 | 6 == PN_INT(potion_send(PN_string, potion_str(P, "length")))); 69 | } 70 | 71 | void potion_test_empty(CuTest *T) { 72 | PN empty = PN_TUP0(); 73 | CuAssert(T, "empty isn't a tuple", PN_IS_TUPLE(empty)); 74 | CuAssert(T, "empty isn't a ref", PN_IS_PTR(empty)); 75 | CuAssertIntEquals(T, "tuple length is off", 76 | PN_INT(potion_send(empty, potion_str(P, "length"))), 0); 77 | } 78 | 79 | void potion_test_tuple(CuTest *T) { 80 | PN tup = potion_tuple_with_size(P, 3); 81 | PN_TUPLE_AT(tup, 0) = PN_NIL; 82 | PN_TUPLE_AT(tup, 1) = PN_string; 83 | PN_TUPLE_AT(tup, 2) = tup; 84 | CuAssert(T, "tuple isn't a tuple", PN_IS_TUPLE(tup)); 85 | CuAssert(T, "tuple isn't a ref", PN_IS_PTR(tup)); 86 | CuAssertIntEquals(T, "tuple length is off", 87 | PN_INT(potion_send(tup, potion_str(P, "length"))), 3); 88 | } 89 | 90 | void potion_test_sig(CuTest *T) { 91 | PN sig = potion_sig(P, "num1=N,num2=N"); 92 | CuAssert(T, "signature isn't a tuple", PN_IS_TUPLE(sig)); 93 | 94 | sig = potion_sig(P, "x=N,y=N|r=N"); 95 | CuAssert(T, "signature isn't a tuple", PN_IS_TUPLE(sig)); 96 | } 97 | 98 | void potion_test_eval(CuTest *T) { 99 | PN add = potion_eval(P, potion_str(P, "(x, y): x + y."), POTION_JIT); 100 | PN_F addfn = PN_CLOSURE_F(add); 101 | PN num = addfn(P, add, 0, PN_NUM(3), PN_NUM(5)); 102 | CuAssertIntEquals(T, "calling closure as c func failed", 103 | PN_INT(num), 8); 104 | } 105 | 106 | void potion_test_allocated(CuTest *T) { 107 | void *scanptr = (void *)((char *)P->mem->birth_lo + PN_ALIGN(sizeof(struct PNMemory), 8)); 108 | while ((PN)scanptr < (PN)P->mem->birth_cur) { 109 | if (((struct PNFwd *)scanptr)->fwd != POTION_FWD && ((struct PNFwd *)scanptr)->fwd != POTION_COPIED) { 110 | CuAssert(T, "wrong type for allocated object", ((struct PNObject *)scanptr)->vt <= PN_TUSER); 111 | } 112 | scanptr = (void *)((char *)scanptr + potion_type_size(P, scanptr)); 113 | CuAssert(T, "allocated object goes beyond GC pointer", (PN)scanptr <= (PN)P->mem->birth_cur); 114 | } 115 | } 116 | 117 | CuSuite *potion_suite() { 118 | CuSuite *S = CuSuiteNew(); 119 | SUITE_ADD_TEST(S, potion_test_nil); 120 | SUITE_ADD_TEST(S, potion_test_bool); 121 | SUITE_ADD_TEST(S, potion_test_int1); 122 | SUITE_ADD_TEST(S, potion_test_int2); 123 | SUITE_ADD_TEST(S, potion_test_int3); 124 | SUITE_ADD_TEST(S, potion_test_decimal); 125 | SUITE_ADD_TEST(S, potion_test_str); 126 | SUITE_ADD_TEST(S, potion_test_empty); 127 | SUITE_ADD_TEST(S, potion_test_tuple); 128 | SUITE_ADD_TEST(S, potion_test_sig); 129 | SUITE_ADD_TEST(S, potion_test_eval); 130 | SUITE_ADD_TEST(S, potion_test_allocated); 131 | return S; 132 | } 133 | 134 | int main(void) { 135 | POTION_INIT_STACK(sp); 136 | int count; 137 | P = potion_create(sp); 138 | CuString *out = CuStringNew(); 139 | CuSuite *suite = potion_suite(); 140 | CuSuiteRun(suite); 141 | CuSuiteSummary(suite, out); 142 | CuSuiteDetails(suite, out); 143 | printf("%s\n", out->buffer); 144 | count = suite->failCount; 145 | CuSuiteFree(suite); 146 | CuStringFree(out); 147 | return count; 148 | } 149 | -------------------------------------------------------------------------------- /core/gc.h: -------------------------------------------------------------------------------- 1 | // 2 | // gc.h 3 | // 4 | // (c) 2008 why the lucky stiff, the freelance professor 5 | // 6 | #ifndef POTION_GC_H 7 | #define POTION_GC_H 8 | 9 | #ifndef POTION_BIRTH_SIZE 10 | #define POTION_BIRTH_SIZE (PN_SIZE_T << 21) 11 | #endif 12 | 13 | #ifndef POTION_MIN_BIRTH_SIZE 14 | #define POTION_MIN_BIRTH_SIZE (PN_SIZE_T << 15) 15 | #endif 16 | 17 | #ifndef POTION_MAX_BIRTH_SIZE 18 | #define POTION_MAX_BIRTH_SIZE (16 * POTION_BIRTH_SIZE) 19 | #endif 20 | 21 | #if POTION_MAX_BIRTH_SIZE < 4 * POTION_BIRTH_SIZE 22 | #error invalid min and max birth sizes 23 | #endif 24 | 25 | #define POTION_GC_THRESHOLD (3 * POTION_BIRTH_SIZE) 26 | #define POTION_GC_PERIOD 256 27 | #define POTION_NB_ROOTS 64 28 | 29 | #define SET_GEN(t, p, s) \ 30 | M->t##_lo = p; \ 31 | M->t##_cur = p + (sizeof(PN) * 2); \ 32 | M->t##_hi = p + (s); \ 33 | p = 0 34 | 35 | #define SET_STOREPTR(n) \ 36 | M->birth_storeptr = (void *)(((void **)M->birth_hi) - (n)) 37 | 38 | #define GC_KEEP(p) \ 39 | *(M->birth_storeptr--) = (void *)p 40 | 41 | #define DEL_BIRTH_REGION() \ 42 | if (M->birth_lo == M && IN_BIRTH_REGION(M->protect)) { \ 43 | void *protend = (void *)PN_ALIGN((_PN)M->protect, POTION_PAGESIZE); \ 44 | pngc_page_delete(protend, (char *)M->birth_hi - (char *)protend); \ 45 | } else { \ 46 | pngc_page_delete((void *)M->birth_lo, (char *)M->birth_hi - (char *)M->birth_lo); \ 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/mt19937ar.c: -------------------------------------------------------------------------------- 1 | /* 2 | A C-program for MT19937, with initialization improved 2002/2/10. 3 | Coded by Takuji Nishimura and Makoto Matsumoto. 4 | This is a faster version by taking Shawn Cokus's optimization, 5 | Matthe Bellew's simplification, Isaku Wada's real version. 6 | 7 | Before using, initialize the state by using init_genrand(seed) 8 | or init_by_array(init_key, key_length). 9 | 10 | Copyright (C) 1997 - 2002, Makoto Matsumoto and Takuji Nishimura, 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 15 | are met: 16 | 17 | 1. Redistributions of source code must retain the above copyright 18 | notice, this list of conditions and the following disclaimer. 19 | 20 | 2. 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 | 3. The names of its contributors may not be used to endorse or promote 25 | products derived from this software without specific prior written 26 | permission. 27 | 28 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 29 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 30 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 31 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR 32 | CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 33 | EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, 34 | PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 35 | PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 36 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 37 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 38 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 39 | 40 | 41 | Any feedback is very welcome. 42 | http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/emt.html 43 | email: m-mat @ math.sci.hiroshima-u.ac.jp (remove space) 44 | */ 45 | 46 | #include 47 | #include "potion.h" 48 | 49 | /* Period parameters */ 50 | #define N 624 51 | #define M 397 52 | #define MATRIX_A 0x9908b0dfUL /* constant vector a */ 53 | #define UMASK 0x80000000UL /* most significant w-r bits */ 54 | #define LMASK 0x7fffffffUL /* least significant r bits */ 55 | #define MIXBITS(u,v) ( ((u) & UMASK) | ((v) & LMASK) ) 56 | #define TWIST(u,v) ((MIXBITS(u,v) >> 1) ^ ((v)&1UL ? MATRIX_A : 0UL)) 57 | 58 | static unsigned long state[N]; /* the array for the state vector */ 59 | static int left = 1; 60 | static int initf = 0; 61 | static unsigned long *next; 62 | 63 | /* initializes state[N] with a seed */ 64 | void init_genrand(unsigned long s) { 65 | int j; 66 | state[0]= s & 0xffffffffUL; 67 | for (j=1; j> 30)) + j); 69 | /* See Knuth TAOCP Vol2. 3rd Ed. P.106 for multiplier. */ 70 | /* In the previous versions, MSBs of the seed affect */ 71 | /* only MSBs of the array state[]. */ 72 | /* 2002/01/09 modified by Makoto Matsumoto */ 73 | state[j] &= 0xffffffffUL; /* for >32 bit machines */ 74 | } 75 | left = 1; initf = 1; 76 | } 77 | 78 | /* initialize by an array with array-length */ 79 | /* init_key is the array for initializing keys */ 80 | /* key_length is its length */ 81 | /* slight change for C++, 2004/2/26 */ 82 | void init_by_array(unsigned long init_key[], int key_length) { 83 | int i, j, k; 84 | init_genrand(19650218UL); 85 | i=1; j=0; 86 | k = (N>key_length ? N : key_length); 87 | for (; k; k--) { 88 | state[i] = (state[i] ^ ((state[i-1] ^ (state[i-1] >> 30)) * 1664525UL)) 89 | + init_key[j] + j; /* non linear */ 90 | state[i] &= 0xffffffffUL; /* for WORDSIZE > 32 machines */ 91 | i++; j++; 92 | if (i>=N) { state[0] = state[N-1]; i=1; } 93 | if (j>=key_length) j=0; 94 | } 95 | for (k=N-1; k; k--) { 96 | state[i] = (state[i] ^ ((state[i-1] ^ (state[i-1] >> 30)) * 1566083941UL)) 97 | - i; /* non linear */ 98 | state[i] &= 0xffffffffUL; /* for WORDSIZE > 32 machines */ 99 | i++; 100 | if (i>=N) { state[0] = state[N-1]; i=1; } 101 | } 102 | 103 | state[0] = 0x80000000UL; /* MSB is 1; assuring non-zero initial array */ 104 | left = 1; initf = 1; 105 | } 106 | 107 | static void next_state(void) { 108 | unsigned long *p=state; 109 | int j; 110 | 111 | /* if init_genrand() has not been called, */ 112 | /* a default initial seed is used */ 113 | if (initf==0) init_genrand(5489UL); 114 | 115 | left = N; 116 | next = state; 117 | 118 | for (j=N-M+1; --j; p++) 119 | *p = p[M] ^ TWIST(p[0], p[1]); 120 | 121 | for (j=M; --j; p++) 122 | *p = p[M-N] ^ TWIST(p[0], p[1]); 123 | 124 | *p = p[M-N] ^ TWIST(p[0], state[0]); 125 | } 126 | 127 | /* generates a random number on [0,0xffffffff]-interval */ 128 | unsigned long potion_rand_int(void) { 129 | unsigned long y; 130 | 131 | if (--left == 0) next_state(); 132 | y = *next++; 133 | 134 | /* Tempering */ 135 | y ^= (y >> 11); 136 | y ^= (y << 7) & 0x9d2c5680UL; 137 | y ^= (y << 15) & 0xefc60000UL; 138 | y ^= (y >> 18); 139 | 140 | return y; 141 | } 142 | 143 | /* generates a random number on [0,1) with 53-bit resolution*/ 144 | double potion_rand_double(void) { 145 | unsigned long a=potion_rand_int()>>5, b=potion_rand_int()>>6; 146 | return(a*67108864.0+b)*(1.0/9007199254740992.0); 147 | } 148 | 149 | PN potion_srand(Potion *P, PN cl, PN self, PN seed) { 150 | init_genrand(seed); 151 | return self; 152 | } 153 | 154 | PN potion_rand(Potion *P, PN cl, PN self) { 155 | return PN_NUM(potion_rand_int()); 156 | } 157 | -------------------------------------------------------------------------------- /core/number.c: -------------------------------------------------------------------------------- 1 | // 2 | // number.c 3 | // simple math 4 | // 5 | // (c) 2008 why the lucky stiff, the freelance professor 6 | // 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include "potion.h" 12 | #include "internal.h" 13 | 14 | PN potion_real(Potion *P, double v) { 15 | vPN(Decimal) d = PN_ALLOC_N(PN_TNUMBER, struct PNDecimal, 0); 16 | d->value = v; 17 | return (PN)d; 18 | } 19 | 20 | PN potion_decimal(Potion *P, char *str, int len) { 21 | char *ptr = str + len; 22 | return potion_real(P, strtod(str, &ptr)); 23 | } 24 | 25 | PN potion_pow(Potion *P, PN cl, PN num, PN sup) { 26 | double x = PN_DBL(num), y = PN_DBL(sup); 27 | double z = pow(x, y); 28 | if (PN_IS_NUM(num) && PN_IS_NUM(sup)) 29 | return PN_NUM((int)z); 30 | return potion_real(P, z); 31 | } 32 | 33 | PN potion_sqrt(Potion *P, PN cl, PN num) { 34 | return potion_real(P, sqrt(PN_DBL(num))); 35 | } 36 | 37 | #define PN_NUM_MATH(int_math) \ 38 | if (PN_IS_NUM(self) && PN_IS_NUM(num)) \ 39 | return PN_NUM(PN_INT(self) int_math PN_INT(num)); \ 40 | return potion_real(P, PN_DBL(self) int_math PN_DBL(num)); 41 | 42 | static PN potion_add(Potion *P, PN closure, PN self, PN num) { 43 | PN_NUM_MATH(+) 44 | } 45 | 46 | static PN potion_sub(Potion *P, PN closure, PN self, PN num) { 47 | PN_NUM_MATH(-) 48 | } 49 | 50 | static PN potion_mult(Potion *P, PN closure, PN self, PN num) { 51 | PN_NUM_MATH(*) 52 | } 53 | 54 | static PN potion_div(Potion *P, PN closure, PN self, PN num) { 55 | PN_NUM_MATH(/) 56 | } 57 | 58 | static PN potion_rem(Potion *P, PN closure, PN self, PN num) { 59 | if (PN_IS_NUM(self) && PN_IS_NUM(num)) 60 | return PN_NUM(PN_INT(self) % PN_INT(num)); 61 | double x = PN_DBL(self), y = PN_DBL(num); 62 | int z = (int)(x / y); 63 | return potion_real(P, x - (y * (double)z)); 64 | } 65 | 66 | static PN potion_bitn(Potion *P, PN closure, PN self) { 67 | if (PN_IS_NUM(self)) 68 | return PN_NUM(~PN_INT(self)); 69 | return (PN)potion_real(P, 0.0); 70 | } 71 | 72 | static PN potion_bitl(Potion *P, PN closure, PN self, PN num) { 73 | if (PN_IS_NUM(self) && PN_IS_NUM(num)) 74 | return PN_NUM(PN_INT(self) << PN_INT(num)); 75 | return (PN)potion_real(P, 0.0); 76 | } 77 | 78 | static PN potion_bitr(Potion *P, PN closure, PN self, PN num) { 79 | if (PN_IS_NUM(self) && PN_IS_NUM(num)) 80 | return PN_NUM(PN_INT(self) >> PN_INT(num)); 81 | return (PN)potion_real(P, 0.0); 82 | } 83 | 84 | static PN potion_num_number(Potion *P, PN closure, PN self) { 85 | return self; 86 | } 87 | 88 | static PN potion_num_step(Potion *P, PN cl, PN self, PN end, PN step, PN block) { 89 | long i, j = PN_INT(end), k = PN_INT(step); 90 | for (i = PN_INT(self); i <= j; i += k) { 91 | PN_CLOSURE(block)->method(P, block, P->lobby, PN_NUM(i)); 92 | } 93 | } 94 | 95 | PN potion_num_string(Potion *P, PN closure, PN self) { 96 | char ints[40]; 97 | if (PN_IS_NUM(self)) { 98 | sprintf(ints, "%ld", PN_INT(self)); 99 | } else { 100 | int len = sprintf(ints, "%.16f", ((struct PNDecimal *)self)->value); 101 | while (len > 0 && ints[len - 1] == '0') len--; 102 | if (ints[len - 1] == '.') len++; 103 | ints[len] = '\0'; 104 | } 105 | return potion_str(P, ints); 106 | } 107 | 108 | static PN potion_num_times(Potion *P, PN cl, PN self, PN block) { 109 | long i, j = PN_INT(self); 110 | if (PN_TYPE(block) != PN_TCLOSURE) 111 | potion_fatal("block argument for times is not a closure"); 112 | for (i = 0; i < j; i++) 113 | PN_CLOSURE(block)->method(P, block, P->lobby, PN_NUM(i)); 114 | return PN_NUM(i); 115 | } 116 | 117 | PN potion_num_to(Potion *P, PN cl, PN self, PN end, PN block) { 118 | long i, s = 1, j = PN_INT(self), k = PN_INT(end); 119 | if (k < j) s = -1; 120 | if (PN_TYPE(block) != PN_TCLOSURE) 121 | potion_fatal("block argument for to is not a closure"); 122 | for (i = j; i != k + s; i += s) 123 | PN_CLOSURE(block)->method(P, block, P->lobby, PN_NUM(i)); 124 | return PN_NUM(abs(i - j)); 125 | } 126 | 127 | static PN potion_num_chr(Potion *P, PN cl, PN self) { 128 | char c = PN_INT(self); 129 | return potion_str2(P, &c, 1); 130 | } 131 | 132 | static PN potion_num_is_integer(Potion *P, PN cl, PN self) { 133 | return PN_IS_NUM(self) ? PN_TRUE : PN_FALSE; 134 | } 135 | 136 | static PN potion_num_is_float(Potion *P, PN cl, PN self) { 137 | return PN_IS_DECIMAL(self) ? PN_TRUE : PN_FALSE; 138 | } 139 | 140 | static PN potion_num_integer(Potion *P, PN cl, PN self) { 141 | if (PN_IS_NUM(self)) 142 | return self; 143 | else 144 | return PN_NUM(floor(((struct PNDecimal *)self)->value)); 145 | } 146 | 147 | static PN potion_abs(Potion *P, PN cl, PN self) { 148 | if (PN_IS_DECIMAL(self)) { 149 | double d = PN_DBL(self); 150 | 151 | if (d < 0.0) 152 | return (PN) potion_real(P, -d); 153 | else 154 | return self; 155 | } 156 | return PN_NUM(labs(PN_INT(self))); 157 | } 158 | 159 | void potion_num_init(Potion *P) { 160 | PN num_vt = PN_VTABLE(PN_TNUMBER); 161 | potion_method(num_vt, "+", potion_add, "value=N"); 162 | potion_method(num_vt, "-", potion_sub, "value=N"); 163 | potion_method(num_vt, "*", potion_mult, "value=N"); 164 | potion_method(num_vt, "/", potion_div, "value=N"); 165 | potion_method(num_vt, "%", potion_rem, "value=N"); 166 | potion_method(num_vt, "~", potion_bitn, 0); 167 | potion_method(num_vt, "<<", potion_bitl, "value=N"); 168 | potion_method(num_vt, ">>", potion_bitr, "value=N"); 169 | potion_method(num_vt, "**", potion_pow, "value=N"); 170 | potion_method(num_vt, "number", potion_num_number, 0); 171 | potion_method(num_vt, "sqrt", potion_sqrt, 0); 172 | potion_method(num_vt, "step", potion_num_step, "end=N,step=N,block=&"); 173 | potion_method(num_vt, "string", potion_num_string, 0); 174 | potion_method(num_vt, "times", potion_num_times, "block=&"); 175 | potion_method(num_vt, "to", potion_num_to, "end=N"); 176 | potion_method(num_vt, "chr", potion_num_chr, 0); 177 | potion_method(num_vt, "integer?", potion_num_is_integer, 0); 178 | potion_method(num_vt, "float?", potion_num_is_float, 0); 179 | potion_method(num_vt, "integer", potion_num_integer, 0); 180 | potion_method(num_vt, "abs", potion_abs, 0); 181 | } 182 | -------------------------------------------------------------------------------- /core/load.c: -------------------------------------------------------------------------------- 1 | // 2 | // load.c 3 | // loading of external code 4 | // 5 | // (c) 2008 why the lucky stiff, the freelance professor 6 | // (c) 2013 by perl11 org 7 | // 8 | #include 9 | #include 10 | #include 11 | #include 12 | #include 13 | #include 14 | #include "potion.h" 15 | #include "internal.h" 16 | #include "table.h" 17 | 18 | void potion_load_code(Potion *P, const char *filename) { 19 | PN buf, code; 20 | struct stat stats; 21 | int fd = -1; 22 | if (stat(filename, &stats) == -1) { 23 | fprintf(stderr, "** %s does not exist.", filename); 24 | return; 25 | } 26 | fd = open(filename, O_RDONLY | O_BINARY); 27 | if (fd == -1) { 28 | fprintf(stderr, "** could not open %s. check permissions.", filename); 29 | return; 30 | } 31 | buf = potion_bytes(P, stats.st_size); 32 | if (read(fd, PN_STR_PTR(buf), stats.st_size) == stats.st_size) { 33 | PN_STR_PTR(buf)[stats.st_size] = '\0'; 34 | code = potion_source_load(P, PN_NIL, buf); 35 | if (!PN_IS_PROTO(code)) { 36 | potion_run(P, potion_send( 37 | potion_parse(P, buf, (char *)filename), 38 | PN_compile, potion_str(P, filename), PN_NIL), 39 | POTION_JIT); 40 | } 41 | } else { 42 | fprintf(stderr, "** could not read entire file: %s.", filename); 43 | } 44 | close(fd); 45 | } 46 | 47 | static char *potion_initializer_name(Potion *P, const char *filename, PN_SIZE len) { 48 | PN_SIZE ext_name_len = 0; 49 | char *allocated_str, *ext_name, *func_name; 50 | while (*(filename + ++ext_name_len) != '.' && ext_name_len <= len); 51 | allocated_str = ext_name = malloc(ext_name_len + 1); 52 | if (allocated_str == NULL) potion_allocation_error(); 53 | strncpy(ext_name, filename, ext_name_len); 54 | ext_name[ext_name_len] = '\0'; 55 | ext_name += ext_name_len; 56 | while (*--ext_name != '/' && ext_name >= allocated_str); 57 | ext_name++; 58 | if (asprintf(&func_name, "Potion_Init_%s", ext_name) == -1) 59 | potion_allocation_error(); 60 | free(allocated_str); 61 | return func_name; 62 | } 63 | 64 | void potion_load_dylib(Potion *P, const char *filename) { 65 | void *handle = dlopen(filename, RTLD_LAZY); 66 | void (*func)(Potion *); 67 | char *err, *init_func_name; 68 | if (handle == NULL) { 69 | // TODO: error 70 | fprintf(stderr, "** error loading %s: %s\n", filename, dlerror()); 71 | return; 72 | } 73 | init_func_name = potion_initializer_name(P, filename, strlen(filename)); 74 | func = dlsym(handle, init_func_name); 75 | err = dlerror(); 76 | free(init_func_name); 77 | if (err != NULL) { 78 | fprintf(stderr, "** error loading %s: %s\n", filename, err); 79 | dlclose(handle); 80 | return; 81 | } 82 | func(P); 83 | } 84 | 85 | static PN pn_loader_path; 86 | static const char *pn_loader_extensions[] = { 87 | ".pnb" 88 | , ".pn" 89 | , POTION_LOADEXT 90 | }; 91 | 92 | static const char *find_extension(char *str) { 93 | int i; 94 | PN_SIZE str_len = strlen(str); 95 | struct stat st; 96 | for (i = 0; 97 | i < sizeof(pn_loader_extensions) / sizeof(void *); 98 | i++) { 99 | PN_SIZE len = strlen(pn_loader_extensions[i]); 100 | char buf[str_len + len + 1]; 101 | strncpy(buf, str, str_len); 102 | strncpy(buf + str_len, pn_loader_extensions[i], len); 103 | buf[str_len + len] = '\0'; 104 | if (stat(buf, &st) == 0 && S_ISREG(st.st_mode)) 105 | return pn_loader_extensions[i]; 106 | } 107 | return NULL; 108 | } 109 | 110 | char *potion_find_file(char *str, PN_SIZE str_len) { 111 | char *r = NULL; 112 | struct stat st; 113 | PN_TUPLE_EACH(pn_loader_path, i, prefix, { 114 | PN_SIZE prefix_len = PN_STR_LEN(prefix); 115 | char dirname[prefix_len + 1 + str_len + 1]; 116 | char *str_pos = dirname + prefix_len + 1; 117 | char *dot; 118 | const char *ext; 119 | memcpy(str_pos, str, str_len); 120 | dot = memchr(str, '.', str_len); 121 | if (dot == NULL) 122 | dirname[sizeof(dirname) - 1] = '\0'; 123 | else 124 | *dot = '\0'; 125 | memcpy(dirname, PN_STR_PTR(prefix), prefix_len); 126 | dirname[prefix_len] = '/'; 127 | if (stat(dirname, &st) == 0 && S_ISREG(st.st_mode)) { 128 | if (asprintf(&r, "%s", dirname) == -1) potion_allocation_error(); 129 | break; 130 | } else if ((ext = find_extension(dirname)) != NULL) { 131 | if (asprintf(&r, "%s%s", dirname, ext) == -1) potion_allocation_error(); 132 | break; 133 | } else { 134 | char *file; 135 | if ((file = strrchr(str, '/')) == NULL) 136 | file = str; 137 | else 138 | file++; 139 | if (asprintf(&r, "%s/%s", dirname, file) == -1) potion_allocation_error(); 140 | if (stat(r, &st) != 0 || !S_ISREG(st.st_mode)) { 141 | int r_len = prefix_len + 1 + str_len * 2 + 1; 142 | if ((ext = find_extension(r)) == NULL) { free(r); r = NULL; continue; } 143 | r = realloc(r, r_len + strlen(ext)); 144 | if (r == NULL) potion_allocation_error(); 145 | strcpy(r + r_len, ext); 146 | } 147 | break; 148 | } 149 | }); 150 | return r; 151 | } 152 | 153 | PN potion_load(Potion *P, PN cl, PN self, PN file) { 154 | char *filename = potion_find_file(PN_STR_PTR(file), PN_STR_LEN(file)), *file_ext; 155 | if (filename == NULL) { 156 | fprintf(stderr, "** can't find %s\n", PN_STR_PTR(file)); 157 | return PN_NIL; 158 | } 159 | file_ext = filename + strlen(filename); 160 | while (*--file_ext != '.' && file_ext >= filename); 161 | if (file_ext++ != filename) { 162 | if (strcmp(file_ext, "pn") == 0) 163 | potion_load_code(P, filename); 164 | else if (strcmp(file_ext, "pnb") == 0) 165 | potion_load_code(P, filename); 166 | else if (strcmp(file_ext, POTION_LOADEXT+1) == 0) 167 | potion_load_dylib(P, filename); 168 | else 169 | fprintf(stderr, "** unrecognized file extension: %s\n", file_ext); 170 | } else { 171 | fprintf(stderr, "** no file extension: %s\n", filename); 172 | } 173 | free(filename); 174 | return PN_NIL; 175 | } 176 | 177 | void potion_loader_init(Potion *P) { 178 | pn_loader_path = PN_TUP0(); 179 | PN_PUSH(pn_loader_path, potion_str(P, "lib")); 180 | PN_PUSH(pn_loader_path, potion_str(P, POTION_PREFIX"/lib/potion")); 181 | PN_PUSH(pn_loader_path, potion_str(P, ".")); 182 | 183 | potion_define_global(P, potion_str(P, "LOADER_PATH"), pn_loader_path); 184 | potion_method(P->lobby, "load", potion_load, "file=S"); 185 | } 186 | 187 | void potion_loader_add(Potion *P, PN path) { 188 | PN_PUSH(pn_loader_path, path); 189 | } 190 | -------------------------------------------------------------------------------- /tools/config.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # helper to generate config.inc and core/config.h 3 | 4 | AC="tools/config.c" 5 | AOUT="tools/config.out" 6 | if [ -z "$CC" ]; then 7 | if [ -z "$1" -o "$1" = "compiler" ]; then 8 | case `uname -s` in 9 | *Linux) CC=clang ;; 10 | *) CC=cc ;; 11 | esac 12 | else 13 | CC="$1" 14 | fi 15 | fi 16 | 17 | CCEX="$CC $AC -o $AOUT" 18 | LANG=C 19 | 20 | CCv=`$CC -v 2>&1` 21 | CLANG=`echo "$CCv" | sed "/clang/!d"` 22 | TARGET=`echo "$CCv" | sed -e "/Target:/b" -e "/--target=/b" -e d | sed "s/.* --target=//; s/Target: //; s/ .*//" | head -1` 23 | MINGW_GCC=`echo "$TARGET" | sed "/mingw/!d"` 24 | if [ "$MINGW_GCC" = "" ]; then MINGW=0 25 | else MINGW=1; fi 26 | CYGWIN=`echo "$TARGET" | sed "/cygwin/!d"` 27 | if [ "$CYGWIN" = "" ]; then CYGWIN=0 28 | else CYGWIN=1; fi 29 | BSD=`echo "$TARGET" | sed "/bsd/!d"` 30 | JIT_X86=`echo "$TARGET" | sed "/86/!d"` 31 | JIT_PPC=`echo "$TARGET" | sed "/powerpc/!d"` 32 | JIT_I686=`echo "$TARGET" | sed "/i686/!d"` 33 | JIT_AMD64=`echo "$TARGET" | sed "/amd64/!d"` 34 | JIT_ARM=`echo "$TARGET" | sed "/arm/!d"` 35 | JIT_X86_64=`echo "$TARGET" | sed "/x86_64/!d"` 36 | CROSS=0 37 | 38 | if [ $MINGW -eq 0 ]; then 39 | EXE="" 40 | LIBEXT=".a" 41 | if [ "$CYGWIN" != "1" ]; then 42 | LOADEXT=".so" 43 | DLL=".so" 44 | else 45 | EXE=".exe" 46 | LOADEXT=".dll" 47 | DLL=".dll" 48 | fi 49 | OSX=`echo "$TARGET" | sed "/apple/!d"` 50 | if [ "$OSX" != "" ]; then 51 | OSX=1 52 | LOADEXT=".bundle" 53 | DLL=".dylib" 54 | else 55 | OSX=0 56 | fi 57 | else 58 | EXE=".exe" 59 | LOADEXT=".dll" 60 | DLL=".dll" 61 | LIBEXT=".a" 62 | case `uname -s` in 63 | *Linux|CYGWIN*|Darwin) CROSS=1 ;; 64 | *) CROSS=0 ;; 65 | esac 66 | fi 67 | 68 | if [ "$1" = "compiler" ]; then 69 | echo $CC 70 | elif [ "$2" = "mingw" ]; then 71 | if [ $MINGW -eq 0 ]; then echo "0" 72 | else echo "1"; fi 73 | elif [ "$2" = "apple" ]; then 74 | if [ $OSX -eq 0 ]; then echo "0" 75 | else echo "1"; fi 76 | elif [ "$2" = "cygwin" ]; then 77 | if [ $CYGWIN -eq 0 ]; then echo "0" 78 | else echo "1"; fi 79 | elif [ "$2" = "clang" ]; then 80 | if [ "$CLANG" = "" ]; then echo "0" 81 | else echo "1"; fi 82 | elif [ "$2" = "bsd" ]; then 83 | if [ "$BSD" = "" ]; then echo "0" 84 | else echo "1"; fi 85 | elif [ "$2" = "version" ]; then 86 | sed "/POTION_VERSION/!d; s/\\\"$//; s/.*\\\"//" < core/potion.h 87 | elif [ "$2" = "target" ]; then 88 | if [ "$CC" = "gcc -m32" ]; then 89 | echo "$TARGET" | sed -e "s,x86_64,i686,; s,-unknown,," 90 | else 91 | echo "$TARGET" | sed -e"s,-unknown,," 92 | fi 93 | elif [ "$2" = "cross" ]; then 94 | echo $CROSS 95 | elif [ "$2" = "jit" ]; then 96 | if [ "$JIT_X86$MINGW_GCC" != "" -o "$JIT_I686" != "" -o "$JIT_AMD64" != "" ]; then 97 | echo "X86" 98 | elif [ "$JIT_PPC" != "" ]; then 99 | echo "PPC" 100 | elif [ "$JIT_ARM" != "" ]; then 101 | echo "ARM" 102 | fi 103 | elif [ "$2" = "strip" ]; then 104 | if [ $MINGW -eq 0 ]; then 105 | if [ $CYGWIN -eq 0 ]; then 106 | echo "strip -x" 107 | else 108 | echo "strip" 109 | fi 110 | else 111 | if [ $CROSS -eq 1 ]; then 112 | echo "$CC" | sed -e"s,-gcc,-strip," 113 | else 114 | echo "echo" 115 | fi 116 | fi 117 | elif [ "$2" = "lib" ]; then 118 | prefix=$5 119 | if [ -n $prefix ]; then 120 | CC="$CC -I$prefix/include -L$prefix/lib" 121 | CCEX="$CC $AC -o $AOUT" 122 | fi 123 | LIBOUT=`echo "#include #include \\"$4\\" int main() { puts(\\"1\\"); return 0; }" > $AC && $CCEX $3 2>/dev/null && $AOUT; rm -f $AOUT` 124 | echo $LIBOUT 125 | else 126 | if [ $MINGW -eq 0 ]; then 127 | LONG=`echo "#include int main() { printf(\\"%d\\", (int)sizeof(long)); return 0; }" > $AC && $CCEX && $AOUT && rm -f $AOUT` 128 | INT=`echo "#include int main() { printf(\\"%d\\", (int)sizeof(int)); return 0; }" > $AC && $CCEX && $AOUT && rm -f $AOUT` 129 | SHORT=`echo "#include int main() { printf(\\"%d\\", (int)sizeof(short)); return 0; }" > $AC && $CCEX && $AOUT && rm -f $AOUT` 130 | CHAR=`echo "#include int main() { printf(\\"%d\\", (int)sizeof(char)); return 0; }" > $AC && $CCEX && $AOUT && rm -f $AOUT` 131 | LLONG=`echo "#include int main() { printf(\\"%d\\", (int)sizeof(long long)); return 0; }" > $AC && $CCEX && $AOUT && rm -f $AOUT` 132 | DOUBLE=`echo "#include int main() { printf(\\"%d\\", (int)sizeof(double)); return 0; }" > $AC && $CCEX && $AOUT && rm -f $AOUT` 133 | LILEND=`echo "#include int main() { short int word = 0x0001; char *byte = (char *) &word; printf(\\"%d\\", (int)byte[0]); return 0; }" > $AC && $CCEX && $AOUT && rm -f $AOUT` 134 | PAGESIZE=`echo "#include #include int main() { printf(\\"%d\\", (int)sysconf(_SC_PAGE_SIZE)); return 0; }" > $AC && $CCEX && $AOUT && rm -f $AOUT` 135 | STACKDIR=`echo "#include #include void a2(int *a, int b, int c) { printf(\\"%d\\", (int)((&b - a) / abs(&b - a))); } void a1(int a) { a2(&a,a+4,a+2); } int main() { a1(9); return 0; }" > $AC && $CCEX && $AOUT && rm -f $AOUT` 136 | ARGDIR=`echo "#include void a2(int *a, int b, int c) { printf(\\"%d\\", (int)(&c - &b)); } void a1(int a) { a2(&a,a+4,a+2); } int main() { a1(9); return 0; }" > $AC && $CCEX && $AOUT && rm -f $AOUT` 137 | HAVE_ASAN=`(echo "#include __attribute__((no_address_safety_analysis)) int main() { puts(\\"1\\"); return 0; }" > $AC && $CCEX $3 2>&1; rm -f $AOUT >/dev/null) | sed "/attribute directive ignored/!d"` 138 | if [ "$HAVE_ASAN" != "" ]; then HAVE_ASAN=0; else HAVE_ASAN=1; fi 139 | else 140 | # hard coded win32 values 141 | if [ "$JIT_X86_64" != "" -o "$JIT_AMD64" != "" ]; then 142 | LONG="8" 143 | else 144 | LONG="4" 145 | fi 146 | INT="4" 147 | SHORT="2" 148 | CHAR="1" 149 | DOUBLE="8" 150 | LLONG="8" 151 | LILEND="1" 152 | PAGESIZE="4096" 153 | STACKDIR="-1" 154 | ARGDIR="1" 155 | HAVE_ASAN="0" 156 | fi 157 | 158 | echo "#define POTION_PLATFORM \"$TARGET\"" 159 | echo "#define POTION_LIBEXT \"$LIBEXT\"" 160 | echo 161 | echo "#define PN_SIZE_T $LONG" 162 | echo "#define LONG_SIZE_T $LONG" 163 | echo "#define DOUBLE_SIZE_T $DOUBLE" 164 | echo "#define INT_SIZE_T $INT" 165 | echo "#define SHORT_SIZE_T $SHORT" 166 | echo "#define CHAR_SIZE_T $CHAR" 167 | echo "#define LONGLONG_SIZE_T $LLONG" 168 | echo "#define PN_LITTLE_ENDIAN $LILEND" 169 | echo "#define POTION_PAGESIZE $PAGESIZE" 170 | echo "#define POTION_STACK_DIR $STACKDIR" 171 | echo "#define POTION_ARGS_DIR $ARGDIR" 172 | echo "#define HAVE_ASAN_ATTR $HAVE_ASAN" 173 | fi 174 | -------------------------------------------------------------------------------- /test/api/CuTest.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | 7 | #include "CuTest.h" 8 | 9 | /*-------------------------------------------------------------------------* 10 | * CuStr 11 | *-------------------------------------------------------------------------*/ 12 | 13 | char* CuStrAlloc(int size) 14 | { 15 | char* new = (char*) malloc( sizeof(char) * (size) ); 16 | return new; 17 | } 18 | 19 | char* CuStrCopy(char* old) 20 | { 21 | int len = strlen(old); 22 | char* new = CuStrAlloc(len + 1); 23 | strcpy(new, old); 24 | return new; 25 | } 26 | 27 | /*-------------------------------------------------------------------------* 28 | * CuString 29 | *-------------------------------------------------------------------------*/ 30 | 31 | void CuStringInit(CuString* str) 32 | { 33 | str->length = 0; 34 | str->size = STRING_MAX; 35 | str->buffer = (char*) malloc(sizeof(char) * str->size); 36 | str->buffer[0] = '\0'; 37 | } 38 | 39 | CuString* CuStringNew(void) 40 | { 41 | CuString* str = (CuString*) malloc(sizeof(CuString)); 42 | str->length = 0; 43 | str->size = STRING_MAX; 44 | str->buffer = (char*) malloc(sizeof(char) * str->size); 45 | str->buffer[0] = '\0'; 46 | return str; 47 | } 48 | 49 | void CuStringResize(CuString* str, int newSize) 50 | { 51 | str->buffer = (char*) realloc(str->buffer, sizeof(char) * newSize); 52 | str->size = newSize; 53 | } 54 | 55 | void CuStringAppend(CuString* str, char* text) 56 | { 57 | int length = strlen(text); 58 | CuStringAppendLen(str, text, length); 59 | } 60 | 61 | void CuStringAppendLen(CuString* str, char* text, long length) 62 | { 63 | if (str->length + length + 1 >= str->size) 64 | CuStringResize(str, str->length + length + 1 + STRING_INC); 65 | str->length += length; 66 | strcat(str->buffer, text); 67 | } 68 | 69 | void CuStringAppendChar(CuString* str, char ch) 70 | { 71 | char text[2]; 72 | text[0] = ch; 73 | text[1] = '\0'; 74 | CuStringAppend(str, text); 75 | } 76 | 77 | void CuStringAppendFormat(CuString* str, char* format, ...) 78 | { 79 | va_list argp; 80 | char buf[HUGE_STRING_LEN]; 81 | va_start(argp, format); 82 | vsprintf(buf, format, argp); 83 | va_end(argp); 84 | CuStringAppend(str, buf); 85 | } 86 | 87 | void CuStringFree(CuString* str) 88 | { 89 | if ( str != NULL ) { 90 | free( str->buffer ); 91 | free( str ); 92 | } 93 | } 94 | 95 | /*-------------------------------------------------------------------------* 96 | * CuTest 97 | *-------------------------------------------------------------------------*/ 98 | 99 | void CuTestInit(CuTest* t, char* name, TestFunction function) 100 | { 101 | t->name = CuStrCopy(name); 102 | t->failed = 0; 103 | t->ran = 0; 104 | t->message = NULL; 105 | t->function = function; 106 | t->jumpBuf = NULL; 107 | } 108 | 109 | CuTest* CuTestNew(char* name, TestFunction function) 110 | { 111 | CuTest* tc = CU_ALLOC(CuTest); 112 | CuTestInit(tc, name, function); 113 | return tc; 114 | } 115 | 116 | void CuTestFree(CuTest* t) 117 | { 118 | if ( t != NULL ) { 119 | free( t->name ); 120 | free( t ); 121 | } 122 | } 123 | 124 | void CuFail(CuTest* tc, char* message) 125 | { 126 | tc->failed = 1; 127 | tc->message = CuStrCopy(message); 128 | if (tc->jumpBuf != 0) longjmp(*(tc->jumpBuf), 0); 129 | } 130 | 131 | void CuAssert(CuTest* tc, char* message, int condition) 132 | { 133 | if (condition) return; 134 | CuFail(tc, message); 135 | } 136 | 137 | void CuAssertTrue(CuTest* tc, int condition) 138 | { 139 | if (condition) return; 140 | CuFail(tc, "assert failed"); 141 | } 142 | 143 | void CuAssertStrEquals(CuTest* tc, char* expected, char* actual) 144 | { 145 | CuString* message; 146 | if (strcmp(expected, actual) == 0) return; 147 | message = CuStringNew(); 148 | CuStringAppend(message, "expected <"); 149 | CuStringAppend(message, expected); 150 | CuStringAppend(message, "> but was <"); 151 | CuStringAppend(message, actual); 152 | CuStringAppend(message, ">"); 153 | CuFail(tc, message->buffer); 154 | } 155 | 156 | void CuAssertIntEquals(CuTest* tc, char *message, int expected, int actual) 157 | { 158 | char buf[STRING_MAX]; 159 | if (expected == actual) return; 160 | sprintf(buf, "%s, expected <%d> but was <%d>", message, expected, actual); 161 | CuFail(tc, buf); 162 | } 163 | 164 | void CuAssertPtrEquals(CuTest* tc, void* expected, void* actual) 165 | { 166 | char buf[STRING_MAX]; 167 | if (expected == actual) return; 168 | sprintf(buf, "expected pointer <0x%p> but was <0x%p>", expected, actual); 169 | CuFail(tc, buf); 170 | } 171 | 172 | void CuAssertPtrNotNull(CuTest* tc, void* pointer) 173 | { 174 | char buf[STRING_MAX]; 175 | if (pointer != NULL ) return; 176 | sprintf(buf, "null pointer unexpected"); 177 | CuFail(tc, buf); 178 | } 179 | 180 | void CuTestRun(CuTest* tc) 181 | { 182 | jmp_buf buf; 183 | tc->jumpBuf = &buf; 184 | if (setjmp(buf) == 0) { 185 | tc->ran = 1; 186 | (tc->function)(tc); 187 | } 188 | tc->jumpBuf = 0; 189 | } 190 | 191 | /*-------------------------------------------------------------------------* 192 | * CuSuite 193 | *-------------------------------------------------------------------------*/ 194 | 195 | void CuSuiteInit(CuSuite* testSuite) 196 | { 197 | testSuite->count = 0; 198 | testSuite->failCount = 0; 199 | } 200 | 201 | CuSuite* CuSuiteNew() 202 | { 203 | CuSuite* testSuite = CU_ALLOC(CuSuite); 204 | CuSuiteInit(testSuite); 205 | return testSuite; 206 | } 207 | 208 | void CuSuiteFree(CuSuite* testSuite) 209 | { 210 | int i; 211 | for (i = 0 ; i < testSuite->count ; ++i) { 212 | CuTestFree( testSuite->list[i] ); 213 | } 214 | free( testSuite ); 215 | } 216 | 217 | void CuSuiteAdd(CuSuite* testSuite, CuTest *testCase) 218 | { 219 | assert(testSuite->count < MAX_TEST_CASES); 220 | testSuite->list[testSuite->count] = testCase; 221 | testSuite->count++; 222 | } 223 | 224 | void CuSuiteAddSuite(CuSuite* testSuite, CuSuite* testSuite2) 225 | { 226 | int i; 227 | for (i = 0 ; i < testSuite2->count ; ++i) { 228 | CuTest* testCase = testSuite2->list[i]; 229 | CuSuiteAdd(testSuite, testCase); 230 | } 231 | } 232 | 233 | void CuSuiteRun(CuSuite* testSuite) 234 | { 235 | int i; 236 | for (i = 0 ; i < testSuite->count ; ++i) { 237 | CuTest* testCase = testSuite->list[i]; 238 | CuTestRun(testCase); 239 | if (testCase->failed) { testSuite->failCount += 1; } 240 | } 241 | } 242 | 243 | void CuSuiteSummary(CuSuite* testSuite, CuString* summary) 244 | { 245 | int i; 246 | for (i = 0 ; i < testSuite->count ; ++i) { 247 | CuTest* testCase = testSuite->list[i]; 248 | CuStringAppend(summary, testCase->failed ? "F" : "."); 249 | } 250 | CuStringAppend(summary, "\n"); 251 | } 252 | 253 | void CuSuiteDetails(CuSuite* testSuite, CuString* details) 254 | { 255 | int i; 256 | int failCount = 0; 257 | 258 | if (testSuite->failCount == 0) { 259 | int passCount = testSuite->count - testSuite->failCount; 260 | char* testWord = passCount == 1 ? "test" : "tests"; 261 | CuStringAppendFormat(details, "OK (%d %s)\n", passCount, testWord); 262 | } 263 | else { 264 | if (testSuite->failCount == 1) 265 | CuStringAppend(details, "There was 1 failure:\n"); 266 | else 267 | CuStringAppendFormat(details, "There were %d failures:\n", testSuite->failCount); 268 | 269 | for (i = 0 ; i < testSuite->count ; ++i) { 270 | CuTest* testCase = testSuite->list[i]; 271 | if (testCase->failed) { 272 | failCount++; 273 | CuStringAppendFormat(details, "%d) %s: %s\n", 274 | failCount, testCase->name, testCase->message); 275 | } 276 | } 277 | CuStringAppend(details, "\n!!!FAILURES!!!\n"); 278 | 279 | CuStringAppendFormat(details, "Runs: %d ", testSuite->count); 280 | CuStringAppendFormat(details, "Passes: %d ", testSuite->count - testSuite->failCount); 281 | CuStringAppendFormat(details, "Fails: %d\n", testSuite->failCount); 282 | } 283 | } 284 | -------------------------------------------------------------------------------- /config.mak: -------------------------------------------------------------------------------- 1 | # -*- makefile -*- 2 | # create config.inc and core/config.h 3 | PREFIX = /usr/local 4 | CC = $(shell tools/config.sh compiler) 5 | WARNINGS = -Wall -Werror -fno-strict-aliasing -Wno-switch -Wno-return-type -Wno-unused-label 6 | CFLAGS = -D_GNU_SOURCE 7 | INCS = -Icore 8 | LIBPTH = -L. 9 | RPATH = -Wl,-rpath=$(shell pwd) 10 | RPATH_INSTALL = -Wl,-rpath=\$${PREFIX}/lib 11 | LIBS = -lm 12 | LDDLLFLAGS = -shared -fpic 13 | AR ?= ar 14 | DEBUG ?= 0 15 | WIN32 = 0 16 | CLANG = 0 17 | JIT = 0 18 | EXE = 19 | APPLE = 0 20 | CYGWIN = 0 21 | RUNPRE = ./ 22 | 23 | CAT = /bin/cat 24 | ECHO = /bin/echo 25 | RANLIB = ranlib 26 | SED = sed 27 | EXPR = expr 28 | 29 | STRIP ?= $(shell tools/config.sh "${CC}" strip) 30 | JIT_TARGET ?= $(shell tools/config.sh "${CC}" jit) 31 | ifneq (${JIT_TARGET},) 32 | JIT = 1 33 | endif 34 | 35 | ifeq (${JIT},1) 36 | #ifeq (${JIT_TARGET},X86) 37 | ifneq (${DEBUG},0) 38 | # http://udis86.sourceforge.net/ x86 16,32,64 bit 39 | # port install udis86 40 | ifeq ($(shell tools/config.sh "${CC}" lib -ludis86 udis86.h),1) 41 | DEFINES += -DHAVE_LIBUDIS86 -DJIT_DEBUG 42 | LIBS += -ludis86 43 | else 44 | ifeq ($(shell tools/config.sh "${CC}" lib -ludis86 udis86.h /opt/local),1) 45 | DEFINES += -DHAVE_LIBUDIS86 -DJIT_DEBUG 46 | INCS += -I/opt/local/include 47 | LIBS += -L/opt/local/lib -ludis86 48 | else 49 | ifeq ($(shell tools/config.sh "${CC}" lib -ludis86 udis86.h /usr/local),1) 50 | DEFINES += -DHAVE_LIBUDIS86 -DJIT_DEBUG 51 | INCS += -I/usr/local/include 52 | LIBS += -L/usr/local/lib -ludis86 53 | else 54 | # http://ragestorm.net/distorm/ x86 16,32,64 bit with all intel/amd extensions 55 | # apt-get install libdistorm64-dev 56 | ifeq ($(shell tools/config.sh "${CC}" lib -ldistorm64 stdlib.h),1) 57 | DEFINES += -DHAVE_LIBDISTORM64 -DJIT_DEBUG 58 | LIBS += -ldistorm64 59 | else 60 | ifeq ($(shell tools/config.sh "${CC}" lib -ldistorm64 stdlib.h /usr/local),1) 61 | DEFINES += -DHAVE_LIBDISTORM64 -DJIT_DEBUG 62 | LIBS += -L/usr/local/lib -ldistorm64 63 | else 64 | # http://bastard.sourceforge.net/libdisasm.html 386 32bit only 65 | # apt-get install libdisasm-dev 66 | ifeq ($(shell tools/config.sh "${CC}" lib -ldisasm libdis.h),1) 67 | DEFINES += -DHAVE_LIBDISASM -DJIT_DEBUG 68 | LIBS += -ldisasm 69 | else 70 | ifeq ($(shell tools/config.sh "${CC}" lib -ldisasm libdis.h /usr/local),1) 71 | DEFINES += -DHAVE_LIBDISASM -DJIT_DEBUG 72 | INCS += -I/usr/local/include 73 | LIBS += -L/usr/local/lib -ldisasm 74 | endif 75 | endif 76 | endif 77 | endif 78 | endif 79 | endif 80 | endif 81 | endif 82 | endif 83 | 84 | # JIT with -O still fails callcc tests 85 | ifneq (${JIT},1) 86 | DEBUGFLAGS += -O3 87 | endif 88 | ifneq ($(shell tools/config.sh "${CC}" clang),0) 89 | CLANG = 1 90 | WARNINGS += -Wno-unused-value 91 | endif 92 | ifeq (${DEBUG},0) 93 | DEBUGFLAGS += -fno-stack-protector 94 | else 95 | DEFINES += -DDEBUG 96 | STRIP = echo 97 | ifneq (${CLANG},1) 98 | DEBUGFLAGS += -g3 -fstack-protector 99 | else 100 | DEBUGFLAGS += -g -fstack-protector 101 | endif 102 | endif 103 | ifeq (${ASAN},1) 104 | DEBUGFLAGS += -fsanitize=address -fno-omit-frame-pointer 105 | DEFINES += -D__SANITIZE_ADDRESS__ 106 | endif 107 | 108 | # CFLAGS += \${DEFINES} \${DEBUGFLAGS} 109 | 110 | ifneq ($(shell tools/config.sh "${CC}" bsd),1) 111 | LIBS += -ldl 112 | endif 113 | CROSS = $(shell tools/config.sh "${CC}" cross) 114 | # cygwin is not WIN32. detect mingw target on cross 115 | ifeq ($(shell tools/config.sh "${CC}" mingw),1) 116 | WIN32 = 1 117 | LDDLLFLAGS = -shared 118 | EXE = .exe 119 | DLL = .dll 120 | LOADEXT = .dll 121 | INCS += -Itools/dlfcn-win32/include 122 | LIBS += -Ltools/dlfcn-win32/lib 123 | RPATH = 124 | RPATH_INSTALL = 125 | ifneq (${CROSS},1) 126 | ECHO = echo 127 | CAT = type 128 | RUNPRE = 129 | else 130 | RANLIB = $(shell echo "${CC}" | sed -e "s,-gcc,-ranlib,") 131 | endif 132 | else 133 | ifeq ($(shell tools/config.sh "${CC}" cygwin),1) 134 | CYGWIN = 1 135 | LDDLLFLAGS = -shared 136 | LOADEXT = .dll 137 | EXE = .exe 138 | DLL = .dll 139 | else 140 | ifeq ($(shell tools/config.sh "${CC}" apple),1) 141 | APPLE = 1 142 | DLL = .dylib 143 | LOADEXT = .bundle 144 | LDDLLFLAGS = -dynamiclib -undefined dynamic_lookup -fpic -Wl,-flat_namespace 145 | LDDLLFLAGS += -install_name "@executable_path/../lib/libpotion${DLL}" 146 | RPATH = 147 | RPATH_INSTALL = 148 | else 149 | DLL = .so 150 | LOADEXT = .so 151 | ifeq (${CC},gcc) 152 | CFLAGS += -rdynamic 153 | endif 154 | endif 155 | endif 156 | endif 157 | 158 | # let an existing config.inc overwrite everything 159 | include config.inc 160 | 161 | config: config.inc core/config.h 162 | 163 | config.inc.echo: 164 | @${ECHO} "PREFIX = ${PREFIX}" 165 | @${ECHO} "ECHO = ${ECHO}" 166 | @${ECHO} "EXE = ${EXE}" 167 | @${ECHO} "DLL = ${DLL}" 168 | @${ECHO} "LOADEXT = ${LOADEXT}" 169 | @${ECHO} "CC = ${CC}" 170 | @${ECHO} "DEFINES = ${DEFINES}" 171 | @${ECHO} "DEBUGFLAGS = ${DEBUGFLAGS}" 172 | @${ECHO} "WARNINGS = ${WARNINGS}" 173 | @${ECHO} "CFLAGS = ${CFLAGS} " "\$$"{DEFINES} "\$$"{DEBUGFLAGS} "\$$"{WARNINGS} 174 | @${ECHO} "INCS = ${INCS}" 175 | @${ECHO} "LIBPTH = ${LIBPTH}" 176 | @${ECHO} "RPATH = ${RPATH}" 177 | @${ECHO} "RPATH_INSTALL = " ${RPATH_INSTALL} 178 | @${ECHO} "LIBS = ${LIBS}" 179 | @${ECHO} "LDDLLFLAGS = ${LDDLLFLAGS}" 180 | @${ECHO} "STRIP = ${STRIP}" 181 | @${ECHO} "RUNPRE = ${RUNPRE}" 182 | @${ECHO} "CROSS = ${CROSS}" 183 | @${ECHO} "APPLE = ${APPLE}" 184 | @${ECHO} "WIN32 = ${WIN32}" 185 | @${ECHO} "CYGWIN = ${CYGWIN}" 186 | @${ECHO} "CLANG = ${CLANG}" 187 | @${ECHO} "JIT = ${JIT}" 188 | @test -n ${JIT_TARGET} && ${ECHO} "JIT_${JIT_TARGET} = 1" 189 | @${ECHO} "DEBUG = ${DEBUG}" 190 | @${ECHO} "REVISION = " $(shell git rev-list --abbrev-commit HEAD | wc -l | ${SED} "s/ //g") 191 | 192 | config.h.echo: 193 | @${ECHO} "#define POTION_CC \"${CC}\"" 194 | @${ECHO} "#define POTION_CFLAGS \"${CFLAGS}\"" 195 | @${ECHO} "#define POTION_MAKE \"${MAKE}\"" 196 | @${ECHO} "#define POTION_PREFIX \"${PREFIX}\"" 197 | @${ECHO} "#define POTION_EXE \"${EXE}\"" 198 | @${ECHO} "#define POTION_DLL \"${DLL}\"" 199 | @${ECHO} "#define POTION_LOADEXT \"${LOADEXT}\"" 200 | @${ECHO} "#define POTION_WIN32 ${WIN32}" 201 | @${ECHO} "#define POTION_JIT ${JIT}" 202 | @test -n ${JIT_TARGET} && ${ECHO} "#define POTION_JIT_TARGET POTION_${JIT_TARGET}" 203 | @test -n ${JIT_TARGET} && ${ECHO} "#define POTION_JIT_NAME " $(shell echo ${JIT_TARGET} | tr A-Z a-z) 204 | @${ECHO} ${DEFINES} | perl -lpe's/-D(\w+)/\n#define \1 1/g; s/=/ /g; s{-I[a-z/:]* }{}g;' 205 | @${ECHO} 206 | @tools/config.sh "${CC}" 207 | 208 | # bootstrap config.inc via `make -f config.mak` 209 | config.inc: tools/config.sh config.mak 210 | @${ECHO} MAKE $@ 211 | @${ECHO} "# -*- makefile -*-" > config.inc 212 | @${ECHO} "# created by ${MAKE} -f config.mak" >> config.inc 213 | @${MAKE} -s -f config.mak config.inc.echo >> $@ 214 | 215 | # Force sync with config.inc 216 | core/config.h: config.inc core/version.h tools/config.sh config.mak 217 | @${ECHO} MAKE $@ 218 | @${CAT} core/version.h > core/config.h 219 | @${MAKE} -s -f config.mak config.h.echo >> core/config.h 220 | 221 | core/version.h: $(shell git show-ref HEAD | ${SED} "s,^.* ,.git/,g") 222 | @${ECHO} MAKE $@ 223 | @${ECHO} "/* created by ${MAKE} -f config.mak */" > core/version.h 224 | @${ECHO} -n "#define POTION_DATE \"" >> core/version.h 225 | @${ECHO} -n $(shell date +%Y-%m-%d) >> core/version.h 226 | @${ECHO} "\"" >> core/version.h 227 | @${ECHO} -n "#define POTION_COMMIT \"" >> core/version.h 228 | @${ECHO} -n $(shell git rev-list HEAD -1 --abbrev=7 --abbrev-commit) >> core/version.h 229 | @${ECHO} "\"" >> core/version.h 230 | @${ECHO} -n "#define POTION_REV " >> core/version.h 231 | @${ECHO} -n $(shell git rev-list --abbrev-commit HEAD | wc -l | ${SED} "s/ //g") >> core/version.h 232 | @${ECHO} >> core/version.h 233 | 234 | .PHONY: config config.inc.echo config.h.echo 235 | -------------------------------------------------------------------------------- /core/internal.c: -------------------------------------------------------------------------------- 1 | // 2 | // internal.c 3 | // memory allocation and innards 4 | // 5 | // (c) 2008 why the lucky stiff, the freelance professor 6 | // 7 | #include 8 | #include 9 | #include "potion.h" 10 | #include "internal.h" 11 | #include "table.h" 12 | #include "gc.h" 13 | 14 | PN PN_allocate, PN_break, PN_call, PN_class, PN_compile, PN_continue, PN_def, 15 | PN_delegated, PN_else, PN_elsif, PN_if, PN_lookup, PN_loop, PN_print, 16 | PN_return, PN_self, PN_string, PN_while; 17 | PN PN_add, PN_sub, PN_mult, PN_div, PN_rem, PN_bitn, PN_bitl, PN_bitr; 18 | 19 | PN potion_allocate(Potion *P, PN cl, PN self, PN len) { 20 | struct PNData *obj = PN_ALLOC_N(PN_TUSER, struct PNData, PN_INT(len)); 21 | obj->siz = len; 22 | return (PN)obj; 23 | } 24 | 25 | static void potion_init(Potion *P) { 26 | PN vtable, obj_vt; 27 | P->lobby = potion_type_new(P, PN_TLOBBY, 0); 28 | vtable = potion_type_new(P, PN_TVTABLE, P->lobby); 29 | obj_vt = potion_type_new(P, PN_TOBJECT, P->lobby); 30 | potion_type_new(P, PN_TNIL, obj_vt); 31 | potion_type_new(P, PN_TNUMBER, obj_vt); 32 | potion_type_new(P, PN_TBOOLEAN, obj_vt); 33 | potion_type_new(P, PN_TSTRING, obj_vt); 34 | potion_type_new(P, PN_TTABLE, obj_vt); 35 | potion_type_new(P, PN_TCLOSURE, obj_vt); 36 | potion_type_new(P, PN_TTUPLE, obj_vt); 37 | potion_type_new(P, PN_TFILE, obj_vt); 38 | potion_type_new(P, PN_TSTATE, obj_vt); 39 | potion_type_new(P, PN_TSOURCE, obj_vt); 40 | potion_type_new(P, PN_TBYTES, obj_vt); 41 | potion_type_new(P, PN_TPROTO, obj_vt); 42 | potion_type_new(P, PN_TWEAK, obj_vt); 43 | potion_type_new(P, PN_TLICK, obj_vt); 44 | potion_type_new(P, PN_TERROR, obj_vt); 45 | potion_type_new(P, PN_TCONT, obj_vt); 46 | potion_str_hash_init(P); 47 | 48 | PN_allocate = potion_str(P, "allocate"); 49 | PN_break = potion_str(P, "break"); 50 | PN_call = potion_str(P, "call"); 51 | PN_continue = potion_str(P, "continue"); 52 | PN_def = potion_str(P, "def"); 53 | PN_delegated = potion_str(P, "delegated"); 54 | PN_class = potion_str(P, "class"); 55 | PN_compile = potion_str(P, "compile"); 56 | PN_else = potion_str(P, "else"); 57 | PN_elsif = potion_str(P, "elsif"); 58 | PN_if = potion_str(P, "if"); 59 | PN_lookup = potion_str(P, "lookup"); 60 | PN_loop = potion_str(P, "loop"); 61 | PN_print = potion_str(P, "print"); 62 | PN_return = potion_str(P, "return"); 63 | PN_self = potion_str(P, "self"); 64 | PN_string = potion_str(P, "string"); 65 | PN_while = potion_str(P, "while"); 66 | 67 | PN_add = potion_str(P, "+"); 68 | PN_sub = potion_str(P, "-"); 69 | PN_mult = potion_str(P, "*"); 70 | PN_div = potion_str(P, "/"); 71 | PN_rem = potion_str(P, "%"); 72 | PN_bitn = potion_str(P, "~"); 73 | PN_bitl = potion_str(P, "<<"); 74 | PN_bitr = potion_str(P, ">>"); 75 | 76 | potion_def_method(P, 0, vtable, PN_lookup, PN_FUNC(potion_lookup, 0)); 77 | potion_def_method(P, 0, vtable, PN_def, PN_FUNC(potion_def_method, "name=S,block=&")); 78 | 79 | potion_send(vtable, PN_def, PN_allocate, PN_FUNC(potion_allocate, 0)); 80 | potion_send(vtable, PN_def, PN_delegated, PN_FUNC(potion_delegated, 0)); 81 | 82 | potion_vm_init(P); 83 | potion_lobby_init(P); 84 | potion_object_init(P); 85 | potion_error_init(P); 86 | potion_cont_init(P); 87 | potion_primitive_init(P); 88 | potion_num_init(P); 89 | potion_str_init(P); 90 | potion_table_init(P); 91 | potion_source_init(P); 92 | potion_lick_init(P); 93 | potion_compiler_init(P); 94 | potion_file_init(P); 95 | potion_loader_init(P); 96 | 97 | GC_PROTECT(P); 98 | } 99 | 100 | Potion *potion_create(void *sp) { 101 | Potion *P = potion_gc_boot(sp); 102 | P->vt = PN_TSTATE; 103 | P->uniq = (PNUniq)potion_rand_int(); 104 | PN_FLEX_NEW(P->vts, PN_TFLEX, PNFlex, TYPE_BATCH_SIZE); 105 | PN_FLEX_SIZE(P->vts) = PN_TYPE_ID(PN_TUSER) + 1; 106 | P->prec = PN_PREC; 107 | P->flags = MODE_P5; 108 | potion_init(P); 109 | return P; 110 | } 111 | 112 | void potion_destroy(Potion *P) { 113 | potion_gc_release(P); 114 | } 115 | 116 | PN potion_delegated(Potion *P, PN closure, PN self) { 117 | PNType t = PN_FLEX_SIZE(P->vts) + PN_TNIL; 118 | PN_FLEX_NEEDS(1, P->vts, PN_TFLEX, PNFlex, TYPE_BATCH_SIZE); 119 | return potion_type_new(P, t, self); 120 | } 121 | 122 | PN potion_call(Potion *P, PN cl, PN_SIZE argc, PN * volatile argv) { 123 | vPN(Closure) c = PN_CLOSURE(cl); 124 | switch (argc) { 125 | case 0: 126 | return c->method(P, cl, cl); 127 | case 1: 128 | return c->method(P, cl, argv[0]); 129 | case 2: 130 | return c->method(P, cl, argv[0], argv[1]); 131 | case 3: 132 | return c->method(P, cl, argv[0], argv[1], argv[2]); 133 | case 4: 134 | return c->method(P, cl, argv[0], argv[1], argv[2], argv[3]); 135 | case 5: 136 | return c->method(P, cl, argv[0], argv[1], argv[2], argv[3], argv[4]); 137 | case 6: 138 | return c->method(P, cl, argv[0], argv[1], argv[2], argv[3], argv[4], 139 | argv[5]); 140 | case 7: 141 | return c->method(P, cl, argv[0], argv[1], argv[2], argv[3], argv[4], 142 | argv[5], argv[6]); 143 | case 8: 144 | return c->method(P, cl, argv[0], argv[1], argv[2], argv[3], argv[4], 145 | argv[5], argv[6], argv[7]); 146 | case 9: 147 | return c->method(P, cl, argv[0], argv[1], argv[2], argv[3], argv[4], 148 | argv[5], argv[6], argv[7], argv[8]); 149 | case 10: 150 | return c->method(P, cl, argv[0], argv[1], argv[2], argv[3], argv[4], 151 | argv[5], argv[6], argv[7], argv[8], argv[9]); 152 | case 11: 153 | return c->method(P, cl, argv[0], argv[1], argv[2], argv[3], argv[4], 154 | argv[5], argv[6], argv[7], argv[8], argv[9], argv[10]); 155 | case 12: 156 | return c->method(P, cl, argv[0], argv[1], argv[2], argv[3], argv[4], 157 | argv[5], argv[6], argv[7], argv[8], argv[9], argv[10], argv[11]); 158 | case 13: 159 | return c->method(P, cl, argv[0], argv[1], argv[2], argv[3], argv[4], 160 | argv[5], argv[6], argv[7], argv[8], argv[9], argv[10], argv[11], 161 | argv[12]); 162 | case 14: 163 | return c->method(P, cl, argv[0], argv[1], argv[2], argv[3], argv[4], 164 | argv[5], argv[6], argv[7], argv[8], argv[9], argv[10], argv[11], 165 | argv[12], argv[13]); 166 | case 15: 167 | return c->method(P, cl, argv[0], argv[1], argv[2], argv[3], argv[4], 168 | argv[5], argv[6], argv[7], argv[8], argv[9], argv[10], argv[11], 169 | argv[12], argv[13], argv[14]); 170 | } 171 | return PN_NIL; // TODO: error "too many arguments" 172 | } 173 | 174 | PNType potion_kind_of(PN obj) { 175 | return potion_type(obj); 176 | } 177 | 178 | PN potion_error(Potion *P, PN msg, long lineno, long charno, PN excerpt) { 179 | struct PNError *e = PN_ALLOC(PN_TERROR, struct PNError); 180 | e->message = msg; 181 | e->line = PN_NUM(lineno); 182 | e->chr = PN_NUM(charno); 183 | e->excerpt = excerpt; 184 | return (PN)e; 185 | } 186 | 187 | PN potion_error_string(Potion *P, PN cl, PN self) { 188 | vPN(Error) e = (struct PNError *)self; 189 | if (e->excerpt == PN_NIL) 190 | return potion_str_format(P, "** %s\n", PN_STR_PTR(e->message)); 191 | return potion_str_format(P, "** %s\n" 192 | "** Where: (line %ld, character %ld) %s\n", PN_STR_PTR(e->message), 193 | PN_INT(e->line), PN_INT(e->chr), PN_STR_PTR(e->excerpt)); 194 | } 195 | 196 | void potion_error_init(Potion *P) { 197 | PN err_vt = PN_VTABLE(PN_TERROR); 198 | potion_method(err_vt, "string", potion_error_string, 0); 199 | } 200 | 201 | #define PN_EXIT_ERROR 1 202 | #define PN_EXIT_FATAL 2 203 | 204 | void potion_fatal(char *message) { 205 | fprintf(stderr, "** %s\n", message); 206 | exit(PN_EXIT_FATAL); 207 | } 208 | 209 | void potion_allocation_error(void) { 210 | potion_fatal("Couldn't allocate memory."); 211 | } 212 | 213 | void potion_p(Potion *P, PN x) { 214 | potion_send(potion_send(x, PN_string), PN_print); 215 | printf("\n"); 216 | } 217 | 218 | void potion_esp(void **esp) { 219 | PN x; 220 | *esp = (void *)&x; 221 | } 222 | 223 | #ifdef DEBUG 224 | void potion_dump(Potion *P, PN data) { 225 | puts(PN_STR_PTR(potion_send(data, PN_string))); 226 | } 227 | 228 | void potion_dump_stack(Potion *P) { 229 | PN_SIZE n; 230 | PN *end, *ebp, *start = P->mem->cstack; 231 | struct PNMemory *M = P->mem; 232 | POTION_ESP(&end); 233 | POTION_EBP(&ebp); 234 | #if POTION_STACK_DIR > 0 235 | n = end - start; 236 | #else 237 | n = start - end + 1; 238 | start = end; 239 | end = M->cstack; 240 | #endif 241 | 242 | printf("-- dumping %u from %p to %p --\n", n, start, end); 243 | printf(" ebp = %p, *ebp = %lx\n", ebp, *ebp); 244 | while (n--) { 245 | printf(" stack(%u) = %lx", n, *start); 246 | if (IS_GC_PROTECTED(*start)) 247 | printf(" gc "); 248 | else if (IN_BIRTH_REGION(*start)) 249 | printf(" gc(0) "); 250 | else if (IN_OLDER_REGION(*start)) 251 | printf(" gc(1) "); 252 | if (*start == 0) 253 | printf(" nil\n"); 254 | else if (*start & 1) 255 | printf(" %ld\n", PN_INT(*start)); 256 | else if (*start & 2) 257 | printf(" %s\n", *start == 2 ? "false" : "true"); 258 | else 259 | printf("\n"); 260 | start++; 261 | } 262 | } 263 | #endif 264 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | 2 | .ooo 3 | 'OOOo 4 | ~ p ooOOOo tion ~ 5 | .OOO 6 | oO %% a little 7 | Oo fast language. 8 | 'O 9 | ` 10 | (o) 11 | ___/ / 12 | /` \ 13 | /v^ ` , 14 | (...v/v^/ 15 | \../::/ 16 | \/::/ 17 | 18 | 19 | ~ potion ~ 20 | 21 | Potion is an object- and mixin-oriented (traits) 22 | language. 23 | 24 | Its exciting points are: 25 | 26 | * Just-in-time compilation to x86 and x86-64 27 | machine code function pointers. This means 28 | she's a speedy one. Who integrates very 29 | well with C extensions. 30 | 31 | The JIT is turned on by default and is 32 | considered the primary mode of operation. 33 | 34 | * Intermediate bytecode format and VM. Load 35 | and dump code. Decent speed and cross- 36 | architecture. Heavily based on Lua's VM. 37 | 38 | * A lightweight generational GC, based on 39 | Basile Starynkevitch's work on Qish. 40 | 41 | 42 | * Bootstrapped "id" object model, based on 43 | Ian Piumarta's soda languages. This means 44 | everything in the language, including 45 | object allocation and interpreter state 46 | are part of the object model. 47 | (See COPYING for citations.) 48 | 49 | * Interpreter is thread-safe and reentrant. 50 | I hope this will facilitate coroutines, 51 | parallel interpreters and sandboxing. 52 | 53 | * Small. Under 10kloc. Right now we're like 54 | 6,000 or something. Install sloccount 55 | and run: make sloc. 56 | 57 | * Reified AST and bytecode structures. This 58 | is very important to me. By giving access 59 | to the parser and compiler, it allows people 60 | to target other platforms, write code analysis 61 | tools and even fully bootstrapped VMs. I'm 62 | not as concerned about the Potion VM being 63 | fully bootstrapped, especially as it is tied 64 | into the JIT so closely. 65 | 66 | * Memory-efficient classes. Stored like C 67 | structs. (Although the method lookup table 68 | can be used like a hash for storing arbitrary 69 | data.) 70 | 71 | * The JIT is also used to speed up some other 72 | bottlenecks. For example, instance variable 73 | and method lookup tables are compiled into 74 | machine code. 75 | 76 | However, some warnings: 77 | 78 | * Strings are immutable (like Lua) and byte 79 | arrays are used for I/O buffers. 80 | 81 | * Limited floating point support yet. 82 | 83 | * Limited error handling. I'm wary of just tossing 84 | in exceptions and feeling rather uninspired 85 | on the matter. Let's hear from you. 86 | 87 | 88 | ~ a whiff of potion ~ 89 | 90 | 5 times: "Odelay!" print. 91 | 92 | Or, 93 | 94 | add = (x, y): x + y. 95 | add(2, 4) string print 96 | 97 | Or, 98 | 99 | hello = 100 | "(x): ('hello ', x) print." eval 101 | hello ('world') 102 | 103 | 104 | ~ building and installing ~ 105 | 106 | $ make 107 | 108 | Look inside the file called INSTALL for options. 109 | 110 | 111 | ~ how it transpired ~ 112 | 113 | This isn't supposed to happen! 114 | 115 | I started playing with Lua's internals and reading 116 | stuff by Ian Piumarta and Nicolas Cannasse. And I, 117 | well... I don't know how this happened! 118 | 119 | Turns out making a language is a lovely old time, 120 | you should try it. If you keep it small, fit the 121 | VM and the parser and the stdlib all into 10k 122 | lines, then it's no sweat. 123 | 124 | To be fair, I'd been tinkering with the parser 125 | for years, though. 126 | 127 | 128 | ~ the potion pledge ~ 129 | 130 | EVERYTHING IS AN OBJECT. 131 | However, OBJECTS AREN'T EVERYTHING. 132 | 133 | (And, incidentally, everything is a function.) 134 | 135 | 136 | ~ items to understand ~ 137 | 138 | 1. A traditional object is a tuple of data 139 | and methods: (D, M). 140 | 141 | D is kept in the object itself. 142 | M is kept in classes. 143 | 144 | 2. In Potion, objects are just D. 145 | 146 | 3. Every object has an M. 147 | 148 | 4. But M can be altered, swapped, 149 | added to, removed from, whatever. 150 | 151 | 5. Objects do not have classes. 152 | The M is a mixin, a collection 153 | of methods. 154 | 155 | Example: all strings have a "length" 156 | method. This method comes with Potion. 157 | It's in the String mixin. 158 | 159 | 6. You can swap out mixins for the span 160 | of a single source file. 161 | 162 | Example: you could give all strings a 163 | "backwards" method. But just for the 164 | code inside your test.pn script. 165 | 166 | 7. You can re-mix for the span of a 167 | single closure. 168 | 169 | To sum up: 170 | 171 | EVERYTHING IS AN OBJECT. 172 | EVEN MIXINS ARE OBJECTS. 173 | AND, OF COURSE, CLOSURES ARE OBJECTS. 174 | 175 | However, OBJECTS AREN'T EVERYTHING. 176 | THEY ARE USELESS WITHOUT MIXINS. 177 | 178 | 179 | ~ unique ideas (to be implemented) ~ 180 | 181 | Potion does have a few unique features 182 | underway. 183 | 184 | * It is two languages in one. 185 | 186 | The language itself is objects and closures. 187 | 188 | Number add = (x): self + x. 189 | 190 | But it also includes a data language. 191 | 192 | app = [window (width=200, height=400) 193 | [button "OK", button "Cancel"]] 194 | 195 | The code and data languages can be interleaved 196 | over and over again. In a way, I'm trying to find 197 | a middle ground between s-expressions and stuff like 198 | E4X. I like that s-expressions are a very light data 199 | syntax, but I like that E4X clearly looks like data. 200 | 201 | When s-expressions appear in Lisp code, they look 202 | like code. I think it is nice to distinguish the two. 203 | 204 | * Deeply nested blocks can be closed quickly. 205 | I don't like significant whitespace, personally. 206 | But I don't like end end end end. 207 | 208 | say = (phrase): 209 | 10 times (i): 210 | 20 times (j): 211 | phrase print 212 | _say 213 | 214 | The closing "_ say" ends the block saved to "say" var. 215 | 216 | Normally, blocks are closed with a period. In this case 217 | we'd need three periods, which looks strange. 218 | 219 | say = (): 220 | 10 times: 221 | 20 times: 222 | "Odelay!" print 223 | ... 224 | 225 | If you prefer, you can give it some space. Or you can 226 | use a variable name introduced by the block, 227 | 228 | say = (phrase): 229 | 10 times (i): 230 | 20 times (j): 231 | phrase print 232 | _ phrase 233 | 234 | say = (phrase): 235 | 10 times (i): 236 | 20 times (j): 237 | phrase print 238 | _ i 239 | . 240 | 241 | Maybe it all looks strange. I don't know. I'm just trying 242 | things out, okay? 243 | 244 | * Elimination of line noise. 245 | 246 | I avoid @, #, $, %, {}. 247 | Stick with ., |, (), [], =, !, ?. Easier on the eyes. 248 | These are common punctuations in English. 249 | 250 | * I try to defer to English when it comes to punctuation rules. 251 | 252 | Period means "end". (In other langs it means "method call".) 253 | Comma breaks up statements. 254 | Space between messages gives a noun-verb feeling. 255 | 256 | window open (width=400, height=500) 257 | 258 | * Named block args. 259 | 260 | (1, 2, 3) map (item=x, index=i): i display, x + 1. 261 | 262 | 263 | ~ feverish and fond thankyous ~ 264 | 265 | I am gravely indebted to Basile Starynkevitch, who fielded my 266 | questions about his garbage collector. I favor French hackers 267 | to an extreme (Xavier Leroy, Nicolas Cannasse, Guy Decoux, 268 | Mathieu Bochard to name only a portion of those I admire) and 269 | am very glad to represent their influence in Potion's garbage 270 | collector. 271 | 272 | Matz, for answering my questions about conservative GC and 273 | for encouraging me so much. Potion's stack scanning code and 274 | some of the object model come from Ruby. 275 | 276 | Steve Dekorte for the Io language, libgarbagecollector and 277 | libcoroutine -- I referred frequently to all of them in 278 | sorting out what I wanted. 279 | 280 | Of course, Mauricio Fernandez for his inspiring programming 281 | journal housed at http://eigenclass.org/R2/ and for works 282 | derived throughout the course of it -- extprot most of all. 283 | Many of my thoughts about language internals (object repr, 284 | GC, etc.) are informed by him. 285 | 286 | Ian Piumarta for peg/leg. I use a re-entrant custom version 287 | of it, but the original library is sheer minimalist parsing 288 | amazement. 289 | 290 | Final appreciations to Jonathan Wright and William Morgan 291 | who pitched in, back in the wee hours of Potion's history. 292 | Tanks. 293 | 294 | 295 | ~ license ~ 296 | 297 | See COPYING for legal information. It's an MIT license, 298 | which lets you do anything you want with this. I'm hoping 299 | that makes it very nice for folks who want to embed a little 300 | Potion in their app! 301 | 302 | -------------------------------------------------------------------------------- /tools/tree.c: -------------------------------------------------------------------------------- 1 | /* Copyright (c) 2007 by Ian Piumarta 2 | * All rights reserved. 3 | * 4 | * Permission is hereby granted, free of charge, to any person obtaining a 5 | * copy of this software and associated documentation files (the 'Software'), 6 | * to deal in the Software without restriction, including without limitation 7 | * the rights to use, copy, modify, merge, publish, distribute, and/or sell 8 | * copies of the Software, and to permit persons to whom the Software is 9 | * furnished to do so, provided that the above copyright notice(s) and this 10 | * permission notice appear in all copies of the Software. Acknowledgement 11 | * of the use of this Software in supporting documentation would be 12 | * appreciated but is not required. 13 | * 14 | * THE SOFTWARE IS PROVIDED 'AS IS'. USE ENTIRELY AT YOUR OWN RISK. 15 | * 16 | * Last edited: 2007-05-15 10:32:09 by piumarta on emilia 17 | */ 18 | 19 | #include 20 | #include 21 | #include 22 | #include 23 | 24 | #include "greg.h" 25 | 26 | Node *actions= 0; 27 | Node *rules= 0; 28 | Node *thisRule= 0; 29 | Node *start= 0; 30 | 31 | FILE *output= 0; 32 | 33 | int actionCount= 0; 34 | int ruleCount= 0; 35 | int lastToken= -1; 36 | 37 | static inline Node *_newNode(int type, int size) 38 | { 39 | Node *node= calloc(1, size); 40 | node->type= type; 41 | return node; 42 | } 43 | 44 | #define newNode(T) _newNode(T, sizeof(struct T)) 45 | 46 | Node *makeRule(char *name, int starts) 47 | { 48 | Node *node= newNode(Rule); 49 | node->rule.name= strdup(name); 50 | node->rule.id= ++ruleCount; 51 | node->rule.flags= starts ? RuleUsed : 0; 52 | node->rule.next= rules; 53 | rules= node; 54 | return node; 55 | } 56 | 57 | Node *findRule(char *name, int starts) 58 | { 59 | Node *n; 60 | char *ptr; 61 | for (ptr= name; *ptr; ptr++) if ('-' == *ptr) *ptr= '_'; 62 | for (n= rules; n; n= n->any.next) 63 | { 64 | assert(Rule == n->type); 65 | if (!strcmp(name, n->rule.name)) 66 | return n; 67 | } 68 | return makeRule(name, starts); 69 | } 70 | 71 | Node *beginRule(Node *rule) 72 | { 73 | actionCount= 0; 74 | return thisRule= rule; 75 | } 76 | 77 | void Rule_setExpression(Node *node, Node *expression) 78 | { 79 | assert(node); 80 | #ifdef DEBUG 81 | Node_print(node); fprintf(stderr, " [%d]<- ", node->type); Node_print(expression); fprintf(stderr, "\n"); 82 | #endif 83 | assert(Rule == node->type); 84 | node->rule.expression= expression; 85 | if (!start || !strcmp(node->rule.name, "start")) 86 | start= node; 87 | } 88 | 89 | Node *makeVariable(char *name) 90 | { 91 | Node *node; 92 | assert(thisRule); 93 | for (node= thisRule->rule.variables; node; node= node->variable.next) 94 | if (!strcmp(name, node->variable.name)) 95 | return node; 96 | node= newNode(Variable); 97 | node->variable.name= strdup(name); 98 | node->variable.next= thisRule->rule.variables; 99 | thisRule->rule.variables= node; 100 | return node; 101 | } 102 | 103 | Node *makeName(Node *rule) 104 | { 105 | Node *node= newNode(Name); 106 | node->name.rule= rule; 107 | node->name.variable= 0; 108 | rule->rule.flags |= RuleUsed; 109 | return node; 110 | } 111 | 112 | Node *makeDot(void) 113 | { 114 | return newNode(Dot); 115 | } 116 | 117 | Node *makeCharacter(char *text) 118 | { 119 | Node *node= newNode(Character); 120 | node->character.value= strdup(text); 121 | return node; 122 | } 123 | 124 | Node *makeString(char *text) 125 | { 126 | Node *node= newNode(String); 127 | node->string.value= strdup(text); 128 | return node; 129 | } 130 | 131 | Node *makeClass(char *text) 132 | { 133 | Node *node= newNode(Class); 134 | node->cclass.value= (unsigned char *)strdup(text); 135 | return node; 136 | } 137 | 138 | Node *makeAction(char *text) 139 | { 140 | Node *node= newNode(Action); 141 | char name[1024]; 142 | assert(thisRule); 143 | sprintf(name, "_%d_%s", ++actionCount, thisRule->rule.name); 144 | node->action.name= strdup(name); 145 | node->action.text= strdup(text); 146 | node->action.list= actions; 147 | node->action.rule= thisRule; 148 | actions= node; 149 | { 150 | char *ptr; 151 | for (ptr= node->action.text; *ptr; ++ptr) 152 | if ('$' == ptr[0] && '$' == ptr[1]) 153 | ptr[1]= ptr[0]= 'y'; 154 | } 155 | return node; 156 | } 157 | 158 | Node *makePredicate(char *text) 159 | { 160 | Node *node= newNode(Predicate); 161 | node->predicate.text= strdup(text); 162 | return node; 163 | } 164 | 165 | Node *makeAlternate(Node *e) 166 | { 167 | if (Alternate != e->type) 168 | { 169 | Node *node= newNode(Alternate); 170 | assert(e); 171 | assert(!e->any.next); 172 | node->alternate.first= 173 | node->alternate.last= e; 174 | return node; 175 | } 176 | return e; 177 | } 178 | 179 | Node *Alternate_append(Node *a, Node *e) 180 | { 181 | assert(a); 182 | a= makeAlternate(a); 183 | assert(a->alternate.last); 184 | assert(e); 185 | a->alternate.last->any.next= e; 186 | a->alternate.last= e; 187 | return a; 188 | } 189 | 190 | Node *makeSequence(Node *e) 191 | { 192 | if (Sequence != e->type) 193 | { 194 | Node *node= newNode(Sequence); 195 | assert(e); 196 | assert(!e->any.next); 197 | node->sequence.first= 198 | node->sequence.last= e; 199 | return node; 200 | } 201 | return e; 202 | } 203 | 204 | Node *Sequence_append(Node *a, Node *e) 205 | { 206 | assert(a); 207 | a= makeSequence(a); 208 | assert(a->sequence.last); 209 | assert(e); 210 | a->sequence.last->any.next= e; 211 | a->sequence.last= e; 212 | return a; 213 | } 214 | 215 | Node *makePeekFor(Node *e) 216 | { 217 | Node *node= newNode(PeekFor); 218 | node->peekFor.element= e; 219 | return node; 220 | } 221 | 222 | Node *makePeekNot(Node *e) 223 | { 224 | Node *node= newNode(PeekNot); 225 | node->peekNot.element= e; 226 | return node; 227 | } 228 | 229 | Node *makeQuery(Node *e) 230 | { 231 | Node *node= newNode(Query); 232 | node->query.element= e; 233 | return node; 234 | } 235 | 236 | Node *makeStar(Node *e) 237 | { 238 | Node *node= newNode(Star); 239 | node->star.element= e; 240 | return node; 241 | } 242 | 243 | Node *makePlus(Node *e) 244 | { 245 | Node *node= newNode(Plus); 246 | node->plus.element= e; 247 | return node; 248 | } 249 | 250 | 251 | static Node *stack[1024]; 252 | static Node **stackPointer= stack; 253 | 254 | 255 | #ifdef DEBUG 256 | static void dumpStack(void) 257 | { 258 | Node **p; 259 | for (p= stack + 1; p <= stackPointer; ++p) 260 | { 261 | fprintf(stderr, "### %ld\t", p - stack); 262 | Node_print(*p); 263 | fprintf(stderr, "\n"); 264 | } 265 | } 266 | #endif 267 | 268 | Node *push(Node *node) 269 | { 270 | assert(node); 271 | assert(stackPointer < stack + 1023); 272 | #ifdef DEBUG 273 | dumpStack(); fprintf(stderr, " PUSH "); Node_print(node); fprintf(stderr, "\n"); 274 | #endif 275 | return *++stackPointer= node; 276 | } 277 | 278 | Node *top(void) 279 | { 280 | assert(stackPointer > stack); 281 | return *stackPointer; 282 | } 283 | 284 | Node *pop(void) 285 | { 286 | assert(stackPointer > stack); 287 | #ifdef DEBUG 288 | dumpStack(); fprintf(stderr, " POP\n"); 289 | #endif 290 | return *stackPointer--; 291 | } 292 | 293 | 294 | static void Node_fprint(FILE *stream, Node *node) 295 | { 296 | assert(node); 297 | switch (node->type) 298 | { 299 | case Rule: fprintf(stream, " %s", node->rule.name); break; 300 | case Name: fprintf(stream, " %s", node->name.rule->rule.name); break; 301 | case Dot: fprintf(stream, " ."); break; 302 | case Character: fprintf(stream, " '%s'", node->character.value); break; 303 | case String: fprintf(stream, " \"%s\"", node->string.value); break; 304 | case Class: fprintf(stream, " [%s]", node->cclass.value); break; 305 | case Action: fprintf(stream, " { %s }", node->action.text); break; 306 | case Predicate: fprintf(stream, " ?{ %s }", node->action.text); break; 307 | 308 | case Alternate: node= node->alternate.first; 309 | fprintf(stream, " ("); 310 | Node_fprint(stream, node); 311 | while ((node= node->any.next)) 312 | { 313 | fprintf(stream, " |"); 314 | Node_fprint(stream, node); 315 | } 316 | fprintf(stream, " )"); 317 | break; 318 | 319 | case Sequence: node= node->sequence.first; 320 | fprintf(stream, " ("); 321 | Node_fprint(stream, node); 322 | while ((node= node->any.next)) 323 | Node_fprint(stream, node); 324 | fprintf(stream, " )"); 325 | break; 326 | 327 | case PeekFor: fprintf(stream, "&"); Node_fprint(stream, node->query.element); break; 328 | case PeekNot: fprintf(stream, "!"); Node_fprint(stream, node->query.element); break; 329 | case Query: Node_fprint(stream, node->query.element); fprintf(stream, "?"); break; 330 | case Star: Node_fprint(stream, node->query.element); fprintf(stream, "*"); break; 331 | case Plus: Node_fprint(stream, node->query.element); fprintf(stream, "+"); break; 332 | default: 333 | fprintf(stream, "\nunknown node type %d\n", node->type); 334 | exit(1); 335 | } 336 | } 337 | 338 | void Node_print(Node *node) { Node_fprint(stderr, node); } 339 | 340 | static void Rule_fprint(FILE *stream, Node *node) 341 | { 342 | assert(node); 343 | assert(Rule == node->type); 344 | fprintf(stream, "%s.%d =", node->rule.name, node->rule.id); 345 | if (node->rule.expression) 346 | Node_fprint(stream, node->rule.expression); 347 | else 348 | fprintf(stream, " UNDEFINED"); 349 | fprintf(stream, " ;\n"); 350 | } 351 | 352 | void Rule_print(Node *node) { Rule_fprint(stderr, node); } 353 | -------------------------------------------------------------------------------- /lib/readline/win32fixes.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Modified by Henry Rawas (henryr@schakra.com) 3 | * - make it compatible with Visual Studio builds 4 | * - added wstrtod to handle INF, NAN 5 | * - added support for using IOCP with sockets 6 | */ 7 | 8 | #ifndef WIN32FIXES_H 9 | #define WIN32FIXES_H 10 | 11 | #ifdef WIN32 12 | #ifndef _WIN32 13 | #define _WIN32 14 | #endif 15 | #endif 16 | 17 | #ifdef _WIN32 18 | #define WIN32_LEAN_AND_MEAN 19 | #define NOGDI 20 | #define __USE_W32_SOCKETS 21 | 22 | #include "fmacros.h" 23 | #include 24 | #include 25 | #include 26 | #include 27 | #include 28 | #ifndef FD_SETSIZE 29 | #define FD_SETSIZE 16000 30 | #endif 31 | #include /* setsocketopt */ 32 | #include 33 | #include 34 | #include 35 | #include /* _O_BINARY */ 36 | #include /* INT_MAX */ 37 | #include 38 | #include 39 | 40 | #define fseeko fseeko64 41 | #define ftello ftello64 42 | 43 | #define inline __inline 44 | 45 | #undef ftruncate 46 | #define ftruncate replace_ftruncate 47 | #ifndef off64_t 48 | #define off64_t off_t 49 | #endif 50 | 51 | int replace_ftruncate(int fd, off64_t length); 52 | 53 | 54 | #define snprintf _snprintf 55 | #define ftello64 _ftelli64 56 | #define fseeko64 _fseeki64 57 | #define strcasecmp _stricmp 58 | #define strtoll _strtoi64 59 | #ifndef _MATH_H_ 60 | #define isnan _isnan 61 | #define isfinite _finite 62 | #define isinf(x) (!_finite(x)) 63 | #endif 64 | #define lseek64 lseek 65 | /* following defined to choose little endian byte order */ 66 | #define __i386__ 1 67 | #if !defined(va_copy) 68 | #define va_copy(d,s) d = (s) 69 | #endif 70 | 71 | #define sleep(x) Sleep((x)*1000) 72 | 73 | #ifndef __RTL_GENRANDOM 74 | #define __RTL_GENRANDOM 1 75 | typedef BOOLEAN (_stdcall* RtlGenRandomFunc)(void * RandomBuffer, ULONG RandomBufferLength); 76 | #endif 77 | RtlGenRandomFunc RtlGenRandom; 78 | 79 | #define random() (long)replace_random() 80 | #define rand() replace_random() 81 | int replace_random(); 82 | 83 | #if !defined(ssize_t) 84 | typedef int ssize_t; 85 | #endif 86 | 87 | #if !defined(mode_t) 88 | #define mode_t long 89 | #endif 90 | 91 | #if !defined(u_int32_t) 92 | /* sha1 */ 93 | typedef unsigned __int32 u_int32_t; 94 | #endif 95 | 96 | /* Redis calls usleep(1) to give thread some time 97 | * Sleep(0) should do the same on windows 98 | * In other cases, usleep is called with milisec resolution, 99 | * which can be directly translated to winapi Sleep() */ 100 | #undef usleep 101 | #define usleep(x) (x == 1) ? Sleep(0) : Sleep((int)((x)/1000)) 102 | 103 | #define pipe(fds) _pipe(fds, 8192, _O_BINARY|_O_NOINHERIT) 104 | 105 | /* Processes */ 106 | #define waitpid(pid,statusp,options) _cwait (statusp, pid, WAIT_CHILD) 107 | 108 | #define WAIT_T int 109 | #define WTERMSIG(x) ((x) & 0xff) /* or: SIGABRT ?? */ 110 | #define WCOREDUMP(x) 0 111 | #define WEXITSTATUS(x) (((x) >> 8) & 0xff) /* or: (x) ?? */ 112 | #define WIFSIGNALED(x) (WTERMSIG (x) != 0) /* or: ((x) == 3) ?? */ 113 | #define WIFEXITED(x) (WTERMSIG (x) == 0) /* or: ((x) != 3) ?? */ 114 | #define WIFSTOPPED(x) 0 115 | 116 | #define WNOHANG 1 117 | 118 | /* file mapping */ 119 | #define PROT_READ 1 120 | #define PROT_WRITE 2 121 | 122 | #define MAP_FAILED (void *) -1 123 | 124 | #define MAP_SHARED 1 125 | #define MAP_PRIVATE 2 126 | 127 | /* rusage */ 128 | #define RUSAGE_SELF 0 129 | #define RUSAGE_CHILDREN (-1) 130 | 131 | #ifndef _RUSAGE_T_ 132 | #define _RUSAGE_T_ 133 | struct rusage { 134 | struct timeval ru_utime; /* user time used */ 135 | struct timeval ru_stime; /* system time used */ 136 | }; 137 | #endif 138 | 139 | int getrusage(int who, struct rusage * rusage); 140 | 141 | /* Signals */ 142 | #define SIGNULL 0 /* Null Check access to pid*/ 143 | #define SIGHUP 1 /* Hangup Terminate; can be trapped*/ 144 | #define SIGINT 2 /* Interrupt Terminate; can be trapped */ 145 | #define SIGQUIT 3 /* Quit Terminate with core dump; can be trapped */ 146 | #define SIGTRAP 5 147 | #define SIGBUS 7 148 | #define SIGKILL 9 /* Kill Forced termination; cannot be trapped */ 149 | #define SIGPIPE 13 150 | #define SIGALRM 14 151 | #define SIGTERM 15 /* Terminate Terminate; can be trapped */ 152 | #define SIGSTOP 17 153 | #define SIGTSTP 18 154 | #define SIGCONT 19 155 | #define SIGCHLD 20 156 | #define SIGTTIN 21 157 | #define SIGTTOU 22 158 | #define SIGABRT 22 159 | /* #define SIGSTOP 24 / * Pause the process; cannot be trapped */ 160 | /* #define SIGTSTP 25 / * Terminal stop Pause the process; can be trapped */ 161 | /* #define SIGCONT 26 */ 162 | #define SIGWINCH 28 163 | #define SIGUSR1 30 164 | #define SIGUSR2 31 165 | 166 | #define ucontext_t void* 167 | 168 | #define SA_NOCLDSTOP 0x00000001u 169 | #define SA_NOCLDWAIT 0x00000002u 170 | #define SA_SIGINFO 0x00000004u 171 | #define SA_ONSTACK 0x08000000u 172 | #define SA_RESTART 0x10000000u 173 | #define SA_NODEFER 0x40000000u 174 | #define SA_RESETHAND 0x80000000u 175 | #define SA_NOMASK SA_NODEFER 176 | #define SA_ONESHOT SA_RESETHAND 177 | #define SA_RESTORER 0x04000000 178 | 179 | 180 | #define sigemptyset(pset) (*(pset) = 0) 181 | #define sigfillset(pset) (*(pset) = (unsigned int)-1) 182 | #define sigaddset(pset, num) (*(pset) |= (1L<<(num))) 183 | #define sigdelset(pset, num) (*(pset) &= ~(1L<<(num))) 184 | #define sigismember(pset, num) (*(pset) & (1L<<(num))) 185 | 186 | #ifndef SIG_SETMASK 187 | #define SIG_SETMASK (0) 188 | #define SIG_BLOCK (1) 189 | #define SIG_UNBLOCK (2) 190 | #endif /*SIG_SETMASK*/ 191 | 192 | typedef void (*__p_sig_fn_t)(int); 193 | typedef int pid_t; 194 | 195 | #ifndef _SIGSET_T_ 196 | #define _SIGSET_T_ 197 | #ifdef _WIN64 198 | typedef unsigned long long _sigset_t; 199 | #else 200 | typedef unsigned long _sigset_t; 201 | #endif 202 | #endif /* _SIGSET_T_ */ 203 | #ifndef _POSIX 204 | # define sigset_t _sigset_t 205 | #endif 206 | 207 | struct sigaction { 208 | int sa_flags; 209 | sigset_t sa_mask; 210 | __p_sig_fn_t sa_handler; 211 | __p_sig_fn_t sa_sigaction; 212 | }; 213 | 214 | int sigaction(int sig, struct sigaction *in, struct sigaction *out); 215 | 216 | /* Sockets */ 217 | 218 | #ifndef ECONNRESET 219 | #define ECONNRESET WSAECONNRESET 220 | #endif 221 | 222 | #ifndef EINPROGRESS 223 | #define EINPROGRESS WSAEINPROGRESS 224 | #endif 225 | 226 | #ifndef ETIMEDOUT 227 | #define ETIMEDOUT WSAETIMEDOUT 228 | #endif 229 | 230 | #define setsockopt(a,b,c,d,e) replace_setsockopt(a,b,c,d,e) 231 | 232 | int replace_setsockopt(int socket, int level, int optname, 233 | const void *optval, socklen_t optlen); 234 | 235 | #define rename(a,b) replace_rename(a,b) 236 | int replace_rename(const char *src, const char *dest); 237 | 238 | //threads avoiding pthread.h 239 | 240 | #define pthread_mutex_t CRITICAL_SECTION 241 | #define pthread_attr_t ssize_t 242 | 243 | #define pthread_mutex_init(a,b) (InitializeCriticalSectionAndSpinCount((a), 0x80000400),0) 244 | #define pthread_mutex_destroy(a) DeleteCriticalSection((a)) 245 | #define pthread_mutex_lock EnterCriticalSection 246 | #define pthread_mutex_unlock LeaveCriticalSection 247 | 248 | #define pthread_equal(t1, t2) ((t1) == (t2)) 249 | 250 | #define pthread_attr_init(x) (*(x) = 0) 251 | #define pthread_attr_getstacksize(x, y) (*(y) = *(x)) 252 | #define pthread_attr_setstacksize(x, y) (*(x) = y) 253 | 254 | #define pthread_t u_int 255 | 256 | int pthread_create(pthread_t *thread, const void *unused, 257 | void *(*start_routine)(void*), void *arg); 258 | 259 | pthread_t pthread_self(void); 260 | 261 | typedef struct { 262 | CRITICAL_SECTION waiters_lock; 263 | LONG waiters; 264 | int was_broadcast; 265 | HANDLE sema; 266 | HANDLE continue_broadcast; 267 | } pthread_cond_t; 268 | 269 | int pthread_cond_init(pthread_cond_t *cond, const void *unused); 270 | int pthread_cond_destroy(pthread_cond_t *cond); 271 | int pthread_cond_wait(pthread_cond_t *cond, pthread_mutex_t *mutex); 272 | int pthread_cond_signal(pthread_cond_t *cond); 273 | 274 | int pthread_detach (pthread_t thread); 275 | 276 | /* Misc Unix -> Win32 */ 277 | int kill(pid_t pid, int sig); 278 | int fsync (int fd); 279 | pid_t wait3(int *stat_loc, int options, void *rusage); 280 | 281 | int w32initWinSock(void); 282 | /* int inet_aton(const char *cp_arg, struct in_addr *addr) */ 283 | 284 | /* redis-check-dump */ 285 | //void *mmap(void *start, size_t length, int prot, int flags, int fd, off offset); 286 | //int munmap(void *start, size_t length); 287 | 288 | int fork(void); 289 | //int gettimeofday(struct timeval *tv, struct timezone *tz); 290 | 291 | /* strtod does not handle Inf and Nan 292 | We need to do the check before calling strtod */ 293 | #undef strtod 294 | #define strtod(nptr, eptr) wstrtod((nptr), (eptr)) 295 | 296 | double wstrtod(const char *nptr, char **eptr); 297 | 298 | 299 | /* structs and functions for using IOCP with windows sockets */ 300 | 301 | /* need callback on write complete. aeWinSendReq is used to pass parameters */ 302 | typedef struct aeWinSendReq { 303 | void *client; 304 | void *data; 305 | char *buf; 306 | int len; 307 | } aeWinSendReq; 308 | 309 | 310 | int aeWinSocketAttach(int fd); 311 | int aeWinSocketDetach(int fd, int shutd); 312 | int aeWinReceiveDone(int fd); 313 | int aeWinSocketSend(int fd, char *buf, int len, int flags, 314 | void *eventLoop, void *client, void *data, void *proc); 315 | int aeWinListen(SOCKET sock, int backlog); 316 | int aeWinAccept(int fd, struct sockaddr *sa, socklen_t *len); 317 | 318 | int strerror_r(int err, char* buf, size_t buflen); 319 | char *wsa_strerror(int err); 320 | 321 | #endif /* WIN32 */ 322 | #endif /* WIN32FIXES_H */ 323 | -------------------------------------------------------------------------------- /core/string.c: -------------------------------------------------------------------------------- 1 | // 2 | // string.c 3 | // internals of utf-8 and byte strings 4 | // 5 | // (c) 2008 why the lucky stiff, the freelance professor 6 | // 7 | #include 8 | #include 9 | #include 10 | #include "potion.h" 11 | #include "internal.h" 12 | #include "khash.h" 13 | #include "table.h" 14 | 15 | #define BYTES_FACTOR 1 / 8 * 9 16 | #define BYTES_CHUNK 32 17 | #define BYTES_ALIGN(len) PN_ALIGN(len + sizeof(struct PNBytes), BYTES_CHUNK) - sizeof(struct PNBytes) 18 | 19 | void potion_add_str(Potion *P, PN s) { 20 | int ret; 21 | kh_put(str, P->strings, s, &ret); 22 | PN_QUICK_FWD(struct PNTable *, P->strings); 23 | } 24 | 25 | PN potion_lookup_str(Potion *P, const char *str) { 26 | vPN(Table) t = P->strings; 27 | unsigned k = kh_get(str, t, str); 28 | if (k != kh_end(t)) return kh_key(str, t, k); 29 | return PN_NIL; 30 | } 31 | 32 | PN potion_str(Potion *P, const char *str) { 33 | PN val = potion_lookup_str(P, str); 34 | if (val == PN_NIL) { 35 | size_t len = strlen(str); 36 | vPN(String) s = PN_ALLOC_N(PN_TSTRING, struct PNString, len + 1); 37 | s->len = (PN_SIZE)len; 38 | PN_MEMCPY_N(s->chars, str, char, len); 39 | s->chars[len] = '\0'; 40 | potion_add_str(P, (PN)s); 41 | val = (PN)s; 42 | } 43 | return val; 44 | } 45 | 46 | PN potion_str2(Potion *P, char *str, size_t len) { 47 | PN exist = PN_NIL; 48 | 49 | vPN(String) s = PN_ALLOC_N(PN_TSTRING, struct PNString, len + 1); 50 | s->len = (PN_SIZE)len; 51 | PN_MEMCPY_N(s->chars, str, char, len); 52 | s->chars[len] = '\0'; 53 | 54 | exist = potion_lookup_str(P, s->chars); 55 | if (exist == PN_NIL) { 56 | potion_add_str(P, (PN)s); 57 | exist = (PN)s; 58 | } 59 | return exist; 60 | } 61 | 62 | PN potion_str_format(Potion *P, const char *format, ...) { 63 | vPN(String) s; 64 | PN_SIZE len; 65 | va_list args; 66 | 67 | va_start(args, format); 68 | len = (PN_SIZE)vsnprintf(NULL, 0, format, args); 69 | va_end(args); 70 | s = PN_ALLOC_N(PN_TSTRING, struct PNString, len + 1); 71 | 72 | va_start(args, format); 73 | vsnprintf(s->chars, len + 1, format, args); 74 | va_end(args); 75 | 76 | return (PN)s; 77 | } 78 | 79 | static PN potion_str_length(Potion *P, PN cl, PN self) { 80 | return PN_NUM(potion_cp_strlen_utf8(PN_STR_PTR(self))); 81 | } 82 | 83 | static PN potion_str_eval(Potion *P, PN cl, PN self) { 84 | return potion_eval(P, self, POTION_JIT); 85 | } 86 | 87 | static PN potion_str_number(Potion *P, PN cl, PN self) { 88 | char *str = PN_STR_PTR(self); 89 | int i = 0, dec = 0, sign = 0, len = PN_STR_LEN(self); 90 | if (len < 1) return PN_ZERO; 91 | 92 | sign = (str[0] == '-' ? -1 : 1); 93 | if (str[0] == '-' || str[0] == '+') { 94 | dec++; str++; len--; 95 | } 96 | for (i = 0; i < len; i++) 97 | if (str[i] < '0' || str[i] > '9') 98 | break; 99 | if (i < 10 && i == len) { 100 | return PN_NUM(sign * PN_ATOI(str, i, 10)); 101 | } 102 | 103 | return potion_decimal(P, PN_STR_PTR(self), PN_STR_LEN(self)); 104 | } 105 | 106 | static PN potion_str_string(Potion *P, PN cl, PN self) { 107 | return self; 108 | } 109 | 110 | static PN potion_str_print(Potion *P, PN cl, PN self) { 111 | fwrite(PN_STR_PTR(self), 1, PN_STR_LEN(self), stdout); 112 | return PN_NIL; 113 | } 114 | 115 | static size_t potion_utf8char_offset(const char *s, size_t index) { 116 | int i; 117 | for (i = 0; s[i]; i++) 118 | if ((s[i] & 0xC0) != 0x80) 119 | if (index-- == 0) 120 | return i; 121 | return i; 122 | } 123 | 124 | inline static PN potion_str_slice_index(PN index, size_t len, int nilvalue) { 125 | int i = PN_INT(index); 126 | int corrected; 127 | if (PN_IS_NIL(index)) { 128 | corrected = nilvalue; 129 | } else if (i < 0) { 130 | corrected = i + len; 131 | if (corrected < 0) { 132 | corrected = 0; 133 | } 134 | } else if (i > len) { 135 | corrected = len; 136 | } else { 137 | corrected = i; 138 | } 139 | return PN_NUM(corrected); 140 | } 141 | 142 | static PN potion_str_slice(Potion *P, PN cl, PN self, PN start, PN end) { 143 | char *str = PN_STR_PTR(self); 144 | size_t len = potion_cp_strlen_utf8(str); 145 | size_t startoffset = potion_utf8char_offset(str, PN_INT(potion_str_slice_index(start, len, 0))); 146 | /* patch applied by http://github.com/citizen428 */ 147 | size_t endoffset; 148 | if (end < start) { 149 | endoffset = potion_utf8char_offset(str, PN_INT(potion_str_slice_index(start+end, len, len))); 150 | } else { 151 | endoffset = potion_utf8char_offset(str, PN_INT(potion_str_slice_index(end, len, len))); 152 | } 153 | /* end patch */ 154 | return potion_str2(P, str + startoffset, endoffset - startoffset); 155 | } 156 | 157 | static PN potion_str_bytes(Potion *P, PN cl, PN self) { 158 | return potion_byte_str2(P, PN_STR_PTR(self), PN_STR_LEN(self)); 159 | } 160 | 161 | static PN potion_str_add(Potion *P, PN cl, PN self, PN x) { 162 | char *s = malloc(PN_STR_LEN(self) + PN_STR_LEN(x)); 163 | PN str; 164 | if (s == NULL) potion_allocation_error(); 165 | PN_MEMCPY_N(s, PN_STR_PTR(self), char, PN_STR_LEN(self)); 166 | PN_MEMCPY_N(s + PN_STR_LEN(self), PN_STR_PTR(x), char, PN_STR_LEN(x)); 167 | str = potion_str2(P, s, PN_STR_LEN(self) + PN_STR_LEN(x)); 168 | free(s); 169 | return str; 170 | } 171 | 172 | static PN potion_str_ord(Potion *P, PN cl, PN self) { 173 | self = potion_fwd(self); 174 | if (PN_STR_LEN(self) != 1) 175 | return PN_NIL; 176 | return PN_NUM(PN_STR_PTR(self)[0]); 177 | } 178 | 179 | static PN potion_str_at(Potion *P, PN cl, PN self, PN index) { 180 | return potion_str_slice(P, cl, self, index, PN_NUM(PN_INT(index) + 1)); 181 | } 182 | 183 | PN potion_byte_str(Potion *P, const char *str) { 184 | return potion_byte_str2(P, str, strlen(str)); 185 | } 186 | 187 | PN potion_byte_str2(Potion *P, const char *str, size_t len) { 188 | vPN(Bytes) s = (struct PNBytes *)potion_bytes(P, len); 189 | PN_MEMCPY_N(s->chars, str, char, len); 190 | s->chars[len] = '\0'; 191 | return (PN)s; 192 | } 193 | 194 | PN potion_bytes(Potion *P, size_t len) { 195 | size_t siz = BYTES_ALIGN(len + 1); 196 | vPN(Bytes) s = PN_ALLOC_N(PN_TBYTES, struct PNBytes, siz); 197 | s->siz = (PN_SIZE)siz; 198 | s->len = (PN_SIZE)len; 199 | return (PN)s; 200 | } 201 | 202 | PN_SIZE pn_printf(Potion *P, PN bytes, const char *format, ...) { 203 | PN_SIZE len; 204 | va_list args; 205 | vPN(Bytes) s = (struct PNBytes *)potion_fwd(bytes); 206 | 207 | va_start(args, format); 208 | len = (PN_SIZE)vsnprintf(NULL, 0, format, args); 209 | va_end(args); 210 | 211 | if (s->len + len + 1 > s->siz) { 212 | size_t siz = BYTES_ALIGN(((s->len + len) * BYTES_FACTOR) + 1); 213 | PN_REALLOC(s, PN_TBYTES, struct PNBytes, siz); 214 | s->siz = (PN_SIZE)siz; 215 | } 216 | 217 | va_start(args, format); 218 | vsnprintf(s->chars + s->len, len + 1, format, args); 219 | va_end(args); 220 | 221 | s->len += len; 222 | return len; 223 | } 224 | 225 | void potion_bytes_obj_string(Potion *P, PN bytes, PN obj) { 226 | potion_bytes_append(P, 0, bytes, potion_send(obj, PN_string)); 227 | } 228 | 229 | PN potion_bytes_append(Potion *P, PN cl, PN self, PN str) { 230 | vPN(Bytes) s = (struct PNBytes *)potion_fwd(self); 231 | PN fstr = potion_fwd(str); 232 | PN_SIZE len = PN_STR_LEN(fstr); 233 | 234 | if (s->len + len + 1 > s->siz) { 235 | size_t siz = BYTES_ALIGN(((s->len + len) * BYTES_FACTOR) + 1); 236 | PN_REALLOC(s, PN_TBYTES, struct PNBytes, siz); 237 | s->siz = (PN_SIZE)siz; 238 | } 239 | 240 | PN_MEMCPY_N(s->chars + s->len, PN_STR_PTR(fstr), char, len); 241 | s->len += len; 242 | s->chars[s->len] = '\0'; 243 | return self; 244 | } 245 | 246 | static PN potion_bytes_length(Potion *P, PN cl, PN self) { 247 | PN str = potion_fwd(self); 248 | return PN_NUM(PN_STR_LEN(str)); 249 | } 250 | 251 | // TODO: ensure it's UTF-8 data 252 | PN potion_bytes_string(Potion *P, PN cl, PN self) { 253 | PN exist = potion_lookup_str(P, PN_STR_PTR(self = potion_fwd(self))); 254 | if (exist == PN_NIL) { 255 | PN_SIZE len = PN_STR_LEN(self); 256 | vPN(String) s = PN_ALLOC_N(PN_TSTRING, struct PNString, len + 1); 257 | s->len = len; 258 | PN_MEMCPY_N(s->chars, PN_STR_PTR(self), char, len + 1); 259 | potion_add_str(P, (PN)s); 260 | exist = (PN)s; 261 | } 262 | return exist; 263 | } 264 | 265 | static PN potion_bytes_print(Potion *P, PN cl, PN self) { 266 | self = potion_fwd(self); 267 | fwrite(PN_STR_PTR(self), 1, PN_STR_LEN(self), stdout); 268 | return PN_NIL; 269 | } 270 | 271 | static PN potion_bytes_each(Potion *P, PN cl, PN self, PN block) { 272 | self = potion_fwd(self); 273 | char *s = PN_STR_PTR(self); 274 | int i; 275 | for (i = 0; i < PN_STR_LEN(self); i++) { 276 | PN_CLOSURE(block)->method(P, block, P->lobby, potion_byte_str2(P, &s[i], 1)); 277 | } 278 | return PN_NIL; 279 | } 280 | 281 | static PN potion_bytes_at(Potion *P, PN cl, PN self, PN index) { 282 | char c; 283 | self = potion_fwd(self); 284 | index = PN_INT(index); 285 | if (index >= PN_STR_LEN(self) || (signed long)index < 0) 286 | return PN_NIL; 287 | c = PN_STR_PTR(self)[index]; 288 | return potion_byte_str2(P, &c, 1); 289 | } 290 | 291 | void potion_str_hash_init(Potion *P) { 292 | P->strings = PN_CALLOC_N(PN_TSTRINGS, struct PNTable, 0); 293 | } 294 | 295 | void potion_str_init(Potion *P) { 296 | PN str_vt = PN_VTABLE(PN_TSTRING); 297 | PN byt_vt = PN_VTABLE(PN_TBYTES); 298 | potion_type_call_is(str_vt, PN_FUNC(potion_str_at, 0)); 299 | potion_method(str_vt, "eval", potion_str_eval, 0); 300 | potion_method(str_vt, "length", potion_str_length, 0); 301 | potion_method(str_vt, "number", potion_str_number, 0); 302 | potion_method(str_vt, "print", potion_str_print, 0); 303 | potion_method(str_vt, "string", potion_str_string, 0); 304 | potion_method(str_vt, "slice", potion_str_slice, "start=N,end=N"); 305 | potion_method(str_vt, "bytes", potion_str_bytes, 0); 306 | potion_method(str_vt, "+", potion_str_add, "str=S"); 307 | potion_method(str_vt, "ord", potion_str_ord, 0); 308 | 309 | potion_type_call_is(byt_vt, PN_FUNC(potion_bytes_at, 0)); 310 | potion_method(byt_vt, "append", potion_bytes_append, "str=S"); 311 | potion_method(byt_vt, "length", potion_bytes_length, 0); 312 | potion_method(byt_vt, "print", potion_bytes_print, 0); 313 | potion_method(byt_vt, "string", potion_bytes_string, 0); 314 | potion_method(byt_vt, "ord", potion_str_ord, 0); 315 | potion_method(byt_vt, "each", potion_bytes_each, "block=&"); 316 | } 317 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # posix (linux, bsd, osx, solaris) + mingw with gcc/clang only 2 | .SUFFIXES: .y .c .i .o .opic .textile .html 3 | .PHONY: all pn static usage config clean doc rebuild test bench tarball dist release install 4 | 5 | SRC = core/asm.c core/ast.c core/callcc.c core/compile.c core/contrib.c core/file.c core/gc.c core/internal.c core/lick.c core/load.c core/mt19937ar.c core/number.c core/objmodel.c core/primitive.c core/string.c core/syntax.c core/table.c core/vm.c 6 | 7 | # bootstrap config.inc with make -f config.mak 8 | include config.inc 9 | 10 | ifeq (${JIT_X86},1) 11 | SRC += core/vm-x86.c 12 | else 13 | ifeq (${JIT_PPC},1) 14 | SRC += core/vm-ppc.c 15 | endif 16 | ifeq (${JIT_ARM},1) 17 | SRC += core/vm-arm.c # not yet ready 18 | endif 19 | endif 20 | 21 | FPIC = 22 | OPIC = o 23 | ifneq (${WIN32},1) 24 | ifneq (${CYGWIN},1) 25 | FPIC = -fPIC 26 | OPIC = opic 27 | endif 28 | endif 29 | OBJ = ${SRC:.c=.o} 30 | PIC_OBJ = ${SRC:.c=.${OPIC}} 31 | OBJ_POTION = core/potion.${OPIC} 32 | OBJ_TEST = test/api/potion-test.o test/api/CuTest.o 33 | OBJ_GC_TEST = test/api/gc-test.o test/api/CuTest.o 34 | OBJ_GC_BENCH = test/api/gc-bench.o 35 | PLIBS = libpotion${DLL} lib/readline${LOADEXT} 36 | DOC = doc/start.textile 37 | DOCHTML = ${DOC:.textile=.html} 38 | 39 | CAT = /bin/cat 40 | ECHO = /bin/echo 41 | MV = /bin/mv 42 | SED = sed 43 | EXPR = expr 44 | GREG = tools/greg${EXE} 45 | RANLIB ?= ranlib 46 | RUNPRE ?= ./ 47 | 48 | all: pn 49 | +${MAKE} -s usage 50 | 51 | pn: potion${EXE} ${PLIBS} 52 | static: libpotion.a potion-s${EXE} 53 | rebuild: clean pn test 54 | 55 | usage: 56 | @${ECHO} " " 57 | @${ECHO} " ~ using potion ~" 58 | @${ECHO} " " 59 | @${ECHO} " Running a script." 60 | 61 | @${ECHO} " " 62 | @${ECHO} " $$ ./potion example/fib.pn" 63 | @${ECHO} " " 64 | @${ECHO} " Dump the AST and bytecode inspection for a script. " 65 | @${ECHO} " " 66 | @${ECHO} " $$ ./potion -V example/fib.pn" 67 | @${ECHO} " " 68 | @${ECHO} " Compiling to bytecode." 69 | @${ECHO} " " 70 | @${ECHO} " $$ ./potion -c example/fib.pn" 71 | @${ECHO} " $$ ./potion example/fib.pnb" 72 | @${ECHO} " " 73 | @${ECHO} " Potion builds its JIT compiler by default, but" 74 | @${ECHO} " you can use the bytecode VM by running scripts" 75 | @${ECHO} " with the -B flag." 76 | @${ECHO} " If you built with JIT=0, then the bytecode VM" 77 | @${ECHO} " will run by default." 78 | @${ECHO} " " 79 | @${ECHO} " To verify your build," 80 | @${ECHO} " " 81 | @${ECHO} " $$ make test" 82 | @${ECHO} " " 83 | @${ECHO} " Originally written by _why the lucky stiff" 84 | @${ECHO} " Maintained at https://github.com/fogus/potion" 85 | 86 | config: 87 | @${ECHO} MAKE -f config.mak $@ 88 | @${MAKE} -s -f config.mak config.inc core/config.h 89 | 90 | # bootstrap config.inc 91 | config.inc: tools/config.sh config.mak 92 | @${MAKE} -s -f config.mak $@ 93 | 94 | core/config.h: config.inc core/version.h tools/config.sh config.mak 95 | @${MAKE} -s -f config.mak $@ 96 | 97 | core/version.h: config.mak $(shell git show-ref HEAD | ${SED} "s,^.* ,.git/,g") 98 | @${MAKE} -s -f config.mak $@ 99 | 100 | core/callcc.o: core/callcc.c 101 | @${ECHO} CC $@ +frame-pointer 102 | @${CC} -c ${CFLAGS} -fno-omit-frame-pointer ${INCS} -o $@ $< 103 | 104 | core/callcc.opic: core/callcc.c 105 | @${ECHO} CC $@ +frame-pointer 106 | @${CC} -c ${CFLAGS} ${FPIC} -fno-omit-frame-pointer ${INCS} -o $@ $< 107 | 108 | core/vm.o core/vm.opic: core/vm-dis.c 109 | 110 | # no optimizations 111 | #core/vm-x86.opic: core/vm-x86.c 112 | # @${ECHO} CC ${FPIC} $@ +frame-pointer 113 | # @${CC} -c -g3 -fstack-protector -fno-omit-frame-pointer -Wall -fno-strict-aliasing -Wno-return-type# -D_GNU_SOURCE ${FPIC} ${INCS} -o $@ $< 114 | 115 | %.i: %.c core/config.h 116 | @${ECHO} CPP $@ 117 | @${CC} -c ${CFLAGS} ${INCS} -o $@ -E -c $< 118 | %.o: %.c core/config.h 119 | @${ECHO} CC $@ 120 | @${CC} -c ${CFLAGS} ${INCS} -o $@ $< 121 | ifneq (${FPIC},) 122 | %.${OPIC}: %.c core/config.h 123 | @${ECHO} CC $@ 124 | @${CC} -c ${FPIC} ${CFLAGS} ${INCS} -o $@ $< 125 | endif 126 | 127 | .c.i: core/config.h 128 | @${ECHO} CPP $@ 129 | @${CC} -c ${CFLAGS} ${INCS} -o $@ -E -c $< 130 | .c.o: core/config.h 131 | @${ECHO} CC $@ 132 | @${CC} -c ${CFLAGS} ${INCS} -o $@ $< 133 | ifneq (${FPIC},) 134 | .c.${OPIC}: core/config.h 135 | @${ECHO} CC $@ 136 | @${CC} -c ${FPIC} ${CFLAGS} ${INCS} -o $@ $< 137 | endif 138 | 139 | %.c: %.y ${GREG} 140 | @${ECHO} GREG $@ 141 | @${GREG} $< > $@-new && ${MV} $@-new $@ 142 | .y.c: ${GREG} 143 | @${ECHO} GREG $@ 144 | @${GREG} $< > $@-new && ${MV} $@-new $@ 145 | 146 | ${GREG}: tools/greg.c tools/compile.c tools/tree.c 147 | @${ECHO} CC $@ 148 | @${CC} -O3 -DNDEBUG -o $@ tools/greg.c tools/compile.c tools/tree.c -Itools 149 | 150 | # the installed version assumes bin/potion loading from ../lib/libpotion (relocatable) 151 | # on darwin we generate a parallel potion/../lib to use @executable_path/../lib/libpotion 152 | ifeq (${APPLE},1) 153 | LIBHACK = ../lib/libpotion.dylib 154 | else 155 | LIBHACK = 156 | endif 157 | ../lib/libpotion.dylib: 158 | -mkdir ../lib 159 | -ln -s `pwd`/libpotion.dylib ../lib/ 160 | 161 | potion${EXE}: ${OBJ_POTION} libpotion${DLL} ${LIBHACK} 162 | @${ECHO} LINK $@ 163 | @${CC} ${CFLAGS} ${OBJ_POTION} -o $@ ${LIBPTH} ${RPATH} -lpotion ${LIBS} 164 | @if [ "${DEBUG}" != "1" ]; then \ 165 | ${ECHO} STRIP $@; \ 166 | ${STRIP} $@; \ 167 | fi 168 | 169 | potion-s${EXE}: core/potion.o libpotion.a ${LIBHACK} 170 | @${ECHO} LINK $@ 171 | @${CC} ${CFLAGS} core/potion.o -o $@ ${LIBPTH} ${RPATH} libpotion.a ${LIBS} 172 | 173 | libpotion.a: ${OBJ} core/config.h core/potion.h 174 | @${ECHO} AR $@ 175 | @if [ -e $@ ]; then rm -f $@; fi 176 | @${AR} rcs $@ core/*.o > /dev/null 177 | 178 | libpotion${DLL}: ${PIC_OBJ} core/config.h core/potion.h 179 | @${ECHO} LD $@ 180 | @if [ -e $@ ]; then rm -f $@; fi 181 | @${CC} ${DEBUGFLAGS} -o $@ ${LDDLLFLAGS} ${RPATH} \ 182 | ${PIC_OBJ} ${LIBS} > /dev/null 183 | 184 | lib/readline${LOADEXT}: core/config.h core/potion.h \ 185 | lib/readline/Makefile lib/readline/linenoise.c \ 186 | lib/readline/linenoise.h 187 | @${ECHO} MAKE $@ 188 | @${MAKE} -s -C lib/readline 189 | @cp lib/readline/readline${LOADEXT} $@ 190 | 191 | bench: potion${EXE} test/api/gc-bench${EXE} 192 | @${ECHO}; \ 193 | ${ECHO} running GC benchmark; \ 194 | time test/api/gc-bench 195 | 196 | test: potion${EXE} test/api/potion-test${EXE} test/api/gc-test${EXE} 197 | @${ECHO}; \ 198 | ${ECHO} running API tests; \ 199 | DYLD_LIBRARY_PATH=`pwd`:$DYLD_LIBRARY_PATH \ 200 | export DYLD_LIBRARY_PATH; \ 201 | test/api/potion-test; \ 202 | ${ECHO} running GC tests; \ 203 | test/api/gc-test; \ 204 | count=0; failed=0; pass=0; \ 205 | while [ $$pass -lt 3 ]; do \ 206 | ${ECHO}; \ 207 | if [ $$pass -eq 0 ]; then \ 208 | ${ECHO} running VM tests; \ 209 | elif [ $$pass -eq 1 ]; then \ 210 | ${ECHO} running compiler tests; \ 211 | else \ 212 | ${ECHO} running JIT tests; \ 213 | jit=`${RUNPRE}potion -v | ${SED} "/jit=1/!d"`; \ 214 | if [ "$$jit" = "" ]; then \ 215 | ${ECHO} skipping; \ 216 | break; \ 217 | fi; \ 218 | fi; \ 219 | for f in test/**/*.pn; do \ 220 | look=`${CAT} $$f | ${SED} "/\#=>/!d; s/.*\#=> //"`; \ 221 | if [ $$pass -eq 0 ]; then \ 222 | for=`${RUNPRE}potion -I -B $$f | ${SED} "s/\n$$//"`; \ 223 | elif [ $$pass -eq 1 ]; then \ 224 | ${RUNPRE}potion -c $$f > /dev/null; \ 225 | fb="$$f"b; \ 226 | for=`${RUNPRE}potion -I -B $$fb | ${SED} "s/\n$$//"`; \ 227 | rm -rf $$fb; \ 228 | else \ 229 | for=`${RUNPRE}potion -I -X $$f | ${SED} "s/\n$$//"`; \ 230 | fi; \ 231 | if [ "$$look" != "$$for" ]; then \ 232 | ${ECHO}; \ 233 | ${ECHO} "$$f: expected <$$look>, but got <$$for>"; \ 234 | failed=`${EXPR} $$failed + 1`; \ 235 | else \ 236 | ${ECHO} -n .; \ 237 | fi; \ 238 | count=`${EXPR} $$count + 1`; \ 239 | done; \ 240 | pass=`${EXPR} $$pass + 1`; \ 241 | done; \ 242 | ${ECHO}; \ 243 | if [ $$failed -gt 0 ]; then \ 244 | ${ECHO} "$$failed FAILS ($$count tests)"; \ 245 | false; \ 246 | else \ 247 | ${ECHO} "OK ($$count tests)"; \ 248 | fi 249 | 250 | test/api/potion-test${EXE}: ${OBJ_TEST} ${OBJ} 251 | @${ECHO} LINK potion-test 252 | @${CC} ${CFLAGS} ${OBJ_TEST} ${OBJ} ${LIBS} -o $@ 253 | 254 | test/api/gc-test${EXE}: ${OBJ_GC_TEST} ${OBJ} 255 | @${ECHO} LINK gc-test 256 | @${CC} ${CFLAGS} ${OBJ_GC_TEST} ${OBJ} ${LIBS} -o $@ 257 | 258 | test/api/gc-bench${EXE}: ${OBJ_GC_BENCH} ${OBJ} 259 | @${ECHO} LINK gc-bench 260 | @${CC} ${CFLAGS} ${OBJ_GC_BENCH} ${OBJ} ${LIBS} -o $@ 261 | 262 | dist: pn static docall 263 | +${MAKE} -f dist.mak $@ PREFIX=${PREFIX} EXE=${EXE} DLL=${DLL} LOADEXT=${LOADEXT} 264 | 265 | install: dist 266 | +${MAKE} -f dist.mak $@ PREFIX=${PREFIX} 267 | 268 | tarball: dist 269 | +${MAKE} -f dist.mak $@ PREFIX=${PREFIX} 270 | 271 | release: dist 272 | +${MAKE} -f dist.mak $@ PREFIX=${PREFIX} 273 | 274 | %.html: %.textile 275 | @${ECHO} DOC $@ 276 | @${ECHO} "" > $@ 277 | @${ECHO} "" >> $@ 278 | @${ECHO} "" >> $@ 279 | @${ECHO} "" >> $@ 280 | @${ECHO} "
" >> $@ 281 | @${ECHO} "
" >> $@ 282 | @redcloth $< >> $@ 283 | @${ECHO} "
" >> $@ 284 | 285 | doc: ${DOCHTML} 286 | docall: doc GTAGS 287 | 288 | MANIFEST: 289 | git ls-tree -r --name-only HEAD > $@ 290 | 291 | # in seperate clean subdir. do not index work files 292 | GTAGS: ${SRC} core/*.h 293 | +${MAKE} -f dist.mak $@ 294 | 295 | TAGS: ${SRC} core/*.h 296 | @rm -f TAGS 297 | /usr/bin/find \( -name \*.c -o -name \*.h \) -exec etags -a --language=c \{\} \; 298 | 299 | sloc: clean 300 | @sloccount core 301 | 302 | todo: 303 | @grep -rInso 'TODO: \(.\+\)' core tools 304 | 305 | clean: 306 | @${ECHO} cleaning 307 | @rm -f core/*.o core/*.opic core/*.i test/api/*.o ${DOCHTML} 308 | @rm -f tools/*.o tools/*~ doc/*~ example/*~ 309 | @rm -f core/config.h core/version.h 310 | @rm -f potion${EXE} potion-s${EXE} libpotion.* \ 311 | test/api/potion-test${EXE} test/api/gc-test${EXE} test/api/gc-bench${EXE} 312 | @rm -rf doc/html doc/latex 313 | 314 | realclean: clean 315 | @rm -f config.inc ${GREG} core/syntax.c 316 | @rm -f GPATH GTAGS GRTAGS 317 | @rm -rf HTML 318 | @find . -name \*.gcov -delete 319 | --------------------------------------------------------------------------------