commit dd3e3cda88add7b972a44cc6270e6c928c9a336f
parent c641facb96181a80e7baa70f2599a7ca309201ce
Author: Andres Navarro <canavarro82@gmail.com>
Date: Mon, 20 Aug 2012 03:30:30 -0300
Completed klisp_State split. Code now compiles and runs the tests without errors or leaks, so it's probably ok. Somehow it worked on the first try... I thought there would be leaks, segmentation faults, failing tests, etc, that would need endless debugging, but I pulled it out flawlessly. Should probably buy a lottery ticket first thing in the morning...
Diffstat:
49 files changed, 582 insertions(+), 474 deletions(-)
diff --git a/src/Makefile b/src/Makefile
@@ -142,7 +142,7 @@ tags:
kapplicative.o: kapplicative.c kobject.h klimits.h klisp.h klispconf.h \
kstate.h ktoken.h kmem.h kapplicative.h koperative.h kgc.h
-kauxlib.o: kauxlib.c klisp.h kobject.h klimits.h klispconf.h kstate.h \
+kauxlib.o: kauxlib.c klisp.h kstate.h klimits.h kobject.h klispconf.h \
ktoken.h kmem.h
kbytevector.o: kbytevector.c kbytevector.h kobject.h klimits.h klisp.h \
klispconf.h kstate.h ktoken.h kmem.h kgc.h kstring.h
@@ -154,143 +154,149 @@ kencapsulation.o: kencapsulation.c kobject.h klimits.h klisp.h \
kenvironment.o: kenvironment.c kenvironment.h kobject.h klimits.h klisp.h \
klispconf.h kstate.h ktoken.h kmem.h kpair.h kgc.h ksymbol.h kstring.h \
kerror.h ktable.h kapplicative.h koperative.h
-kerror.o: kerror.c klisp.h kobject.h klimits.h klispconf.h kpair.h \
+kerror.o: kerror.c klisp.h kpair.h kobject.h klimits.h klispconf.h \
kstate.h ktoken.h kmem.h kgc.h kstring.h kerror.h
-keval.o: keval.c klisp.h kobject.h klimits.h klispconf.h kstate.h \
+keval.o: keval.c klisp.h kstate.h klimits.h kobject.h klispconf.h \
ktoken.h kmem.h kpair.h kgc.h kenvironment.h kcontinuation.h kerror.h \
- kghelpers.h kapplicative.h koperative.h ksymbol.h kstring.h ktable.h
+ kghelpers.h kvector.h kapplicative.h koperative.h ksymbol.h kstring.h \
+ ktable.h
kgbooleans.o: kgbooleans.c kobject.h klimits.h klisp.h klispconf.h \
kstate.h ktoken.h kmem.h kpair.h kgc.h ksymbol.h kstring.h \
- kcontinuation.h kerror.h kghelpers.h kapplicative.h koperative.h \
- kenvironment.h ktable.h kgbooleans.h
+ kcontinuation.h kerror.h kghelpers.h kvector.h kapplicative.h \
+ koperative.h kenvironment.h ktable.h kgbooleans.h
kgbytevectors.o: kgbytevectors.c kstate.h klimits.h klisp.h kobject.h \
klispconf.h ktoken.h kmem.h kapplicative.h koperative.h kcontinuation.h \
- kerror.h kpair.h kgc.h kbytevector.h kghelpers.h kenvironment.h \
- ksymbol.h kstring.h ktable.h kgbytevectors.h
+ kerror.h kpair.h kgc.h kbytevector.h kghelpers.h kvector.h \
+ kenvironment.h ksymbol.h kstring.h ktable.h kgbytevectors.h
kgc.o: kgc.c kgc.h kobject.h klimits.h klisp.h klispconf.h kstate.h \
ktoken.h kmem.h kport.h imath.h imrat.h ktable.h kstring.h kbytevector.h \
kvector.h kerror.h kpair.h
kgchars.o: kgchars.c kstate.h klimits.h klisp.h kobject.h klispconf.h \
ktoken.h kmem.h kapplicative.h koperative.h kcontinuation.h kerror.h \
- kpair.h kgc.h kchar.h kghelpers.h kenvironment.h ksymbol.h kstring.h \
- ktable.h kgchars.h
+ kpair.h kgc.h kchar.h kghelpers.h kvector.h kenvironment.h ksymbol.h \
+ kstring.h ktable.h kgchars.h
kgcombiners.o: kgcombiners.c kstate.h klimits.h klisp.h kobject.h \
klispconf.h ktoken.h kmem.h kpair.h kgc.h kenvironment.h kcontinuation.h \
ksymbol.h kstring.h koperative.h kapplicative.h kerror.h kghelpers.h \
- ktable.h kgcombiners.h
+ kvector.h ktable.h kgcombiners.h
kgcontinuations.o: kgcontinuations.c kstate.h klimits.h klisp.h kobject.h \
klispconf.h ktoken.h kmem.h kpair.h kgc.h kenvironment.h kcontinuation.h \
kapplicative.h koperative.h ksymbol.h kstring.h kerror.h kghelpers.h \
- ktable.h kgcontinuations.h
+ kvector.h ktable.h kgcontinuations.h
kgcontrol.o: kgcontrol.c kstate.h klimits.h klisp.h kobject.h klispconf.h \
ktoken.h kmem.h kpair.h kgc.h kcontinuation.h kerror.h kghelpers.h \
- kapplicative.h koperative.h kenvironment.h ksymbol.h kstring.h ktable.h \
- kgcontrol.h
+ kvector.h kapplicative.h koperative.h kenvironment.h ksymbol.h kstring.h \
+ ktable.h kgcontrol.h
kgencapsulations.o: kgencapsulations.c kstate.h klimits.h klisp.h \
kobject.h klispconf.h ktoken.h kmem.h kencapsulation.h kapplicative.h \
- koperative.h kerror.h kpair.h kgc.h kghelpers.h kcontinuation.h \
- kenvironment.h ksymbol.h kstring.h ktable.h kgencapsulations.h
+ koperative.h kerror.h kpair.h kgc.h kghelpers.h kvector.h \
+ kcontinuation.h kenvironment.h ksymbol.h kstring.h ktable.h \
+ kgencapsulations.h
kgenv_mut.o: kgenv_mut.c kstate.h klimits.h klisp.h kobject.h klispconf.h \
ktoken.h kmem.h kpair.h kgc.h kenvironment.h kcontinuation.h ksymbol.h \
- kstring.h kerror.h kghelpers.h kapplicative.h koperative.h ktable.h \
- kgenv_mut.h
+ kstring.h kerror.h kghelpers.h kvector.h kapplicative.h koperative.h \
+ ktable.h kgenv_mut.h
kgenvironments.o: kgenvironments.c kstate.h klimits.h klisp.h kobject.h \
klispconf.h ktoken.h kmem.h kpair.h kgc.h kenvironment.h kcontinuation.h \
- ksymbol.h kstring.h kerror.h kghelpers.h kapplicative.h koperative.h \
- ktable.h kport.h kread.h kgenvironments.h
+ ksymbol.h kstring.h kerror.h kport.h kread.h kghelpers.h kvector.h \
+ kapplicative.h koperative.h ktable.h kgenvironments.h
kgeqp.o: kgeqp.c kstate.h klimits.h klisp.h kobject.h klispconf.h \
ktoken.h kmem.h kpair.h kgc.h kcontinuation.h kerror.h kghelpers.h \
- kapplicative.h koperative.h kenvironment.h ksymbol.h kstring.h ktable.h \
- kgeqp.h
+ kvector.h kapplicative.h koperative.h kenvironment.h ksymbol.h kstring.h \
+ ktable.h kgeqp.h
kgequalp.o: kgequalp.c kstate.h klimits.h klisp.h kobject.h klispconf.h \
ktoken.h kmem.h kpair.h kgc.h kvector.h kstring.h kbytevector.h \
kcontinuation.h kerror.h kghelpers.h kapplicative.h koperative.h \
kenvironment.h ksymbol.h ktable.h kgequalp.h
kgerrors.o: kgerrors.c kstate.h klimits.h klisp.h kobject.h klispconf.h \
- ktoken.h kmem.h kstring.h kpair.h kgc.h kerror.h kghelpers.h \
+ ktoken.h kmem.h kstring.h kpair.h kgc.h kerror.h kghelpers.h kvector.h \
kapplicative.h koperative.h kcontinuation.h kenvironment.h ksymbol.h \
ktable.h kgerrors.h
kgffi.o: kgffi.c imath.h kobject.h klimits.h klisp.h klispconf.h kstate.h \
ktoken.h kmem.h kinteger.h kpair.h kgc.h kerror.h kbytevector.h \
- kencapsulation.h ktable.h kghelpers.h kapplicative.h koperative.h \
- kcontinuation.h kenvironment.h ksymbol.h kstring.h kgffi.h
+ kencapsulation.h ktable.h kghelpers.h kvector.h kapplicative.h \
+ koperative.h kcontinuation.h kenvironment.h ksymbol.h kstring.h kgffi.h
kghelpers.o: kghelpers.c kghelpers.h kstate.h klimits.h klisp.h kobject.h \
- klispconf.h ktoken.h kmem.h kerror.h kpair.h kgc.h kapplicative.h \
- koperative.h kcontinuation.h kenvironment.h ksymbol.h kstring.h ktable.h \
- kinteger.h imath.h krational.h imrat.h kbytevector.h kvector.h \
+ klispconf.h ktoken.h kmem.h kerror.h kpair.h kgc.h kvector.h \
+ kapplicative.h koperative.h kcontinuation.h kenvironment.h ksymbol.h \
+ kstring.h ktable.h kinteger.h imath.h krational.h imrat.h kbytevector.h \
kencapsulation.h kpromise.h
kgkd_vars.o: kgkd_vars.c kstate.h klimits.h klisp.h kobject.h klispconf.h \
ktoken.h kmem.h kpair.h kgc.h kcontinuation.h koperative.h \
- kapplicative.h kenvironment.h kerror.h kghelpers.h ksymbol.h kstring.h \
- ktable.h kgkd_vars.h
+ kapplicative.h kenvironment.h kerror.h kghelpers.h kvector.h ksymbol.h \
+ kstring.h ktable.h kgkd_vars.h
+kgkeywords.o: kgkeywords.c kstate.h klimits.h klisp.h kobject.h \
+ klispconf.h ktoken.h kmem.h kstring.h ksymbol.h kkeyword.h kerror.h \
+ kpair.h kgc.h kghelpers.h kvector.h kapplicative.h koperative.h \
+ kcontinuation.h kenvironment.h ktable.h kgkeywords.h
kgks_vars.o: kgks_vars.c kstate.h klimits.h klisp.h kobject.h klispconf.h \
ktoken.h kmem.h kpair.h kgc.h kcontinuation.h koperative.h \
- kapplicative.h kenvironment.h kerror.h kghelpers.h ksymbol.h kstring.h \
- ktable.h kgks_vars.h
+ kapplicative.h kenvironment.h kerror.h kghelpers.h kvector.h ksymbol.h \
+ kstring.h ktable.h kgks_vars.h
+kglibraries.o: kglibraries.c kstate.h klimits.h klisp.h kobject.h \
+ klispconf.h ktoken.h kmem.h klibrary.h kapplicative.h koperative.h \
+ kcontinuation.h kerror.h kpair.h kgc.h kenvironment.h kkeyword.h \
+ kstring.h kghelpers.h kvector.h ksymbol.h ktable.h kglibraries.h
kgnumbers.o: kgnumbers.c kstate.h klimits.h klisp.h kobject.h klispconf.h \
ktoken.h kmem.h kapplicative.h koperative.h kcontinuation.h kerror.h \
kpair.h kgc.h ksymbol.h kstring.h kinteger.h imath.h krational.h imrat.h \
- kreal.h kghelpers.h kenvironment.h ktable.h kgnumbers.h
+ kreal.h kghelpers.h kvector.h kenvironment.h ktable.h kgnumbers.h
kgpair_mut.o: kgpair_mut.c kstate.h klimits.h klisp.h kobject.h \
klispconf.h ktoken.h kmem.h kpair.h kgc.h kcontinuation.h ksymbol.h \
- kstring.h kerror.h kghelpers.h kapplicative.h koperative.h \
+ kstring.h kerror.h kghelpers.h kvector.h kapplicative.h koperative.h \
kenvironment.h ktable.h kgpair_mut.h
kgpairs_lists.o: kgpairs_lists.c kstate.h klimits.h klisp.h kobject.h \
klispconf.h ktoken.h kmem.h kpair.h kgc.h kstring.h kcontinuation.h \
- kenvironment.h ksymbol.h kerror.h kghelpers.h kapplicative.h \
+ kenvironment.h ksymbol.h kerror.h kghelpers.h kvector.h kapplicative.h \
koperative.h ktable.h kgpairs_lists.h
kgports.o: kgports.c kstate.h klimits.h klisp.h kobject.h klispconf.h \
- ktoken.h kmem.h kport.h kstring.h kbytevector.h kenvironment.h \
+ ktoken.h kmem.h kport.h kstring.h ktable.h kbytevector.h kenvironment.h \
kapplicative.h koperative.h kcontinuation.h kpair.h kgc.h kerror.h \
- ksymbol.h kread.h kwrite.h kghelpers.h ktable.h kgports.h ktable.h
+ ksymbol.h kread.h kwrite.h kghelpers.h kvector.h kgports.h
kgpromises.o: kgpromises.c kstate.h klimits.h klisp.h kobject.h \
klispconf.h ktoken.h kmem.h kpromise.h kpair.h kgc.h kapplicative.h \
- koperative.h kcontinuation.h kerror.h kghelpers.h kenvironment.h \
- ksymbol.h kstring.h ktable.h kgpromises.h
-kglibraries.o: kglibraries.c kstate.h klimits.h klisp.h kobject.h \
- klispconf.h ktoken.h kmem.h klibrary.h kpair.h kgc.h kapplicative.h \
- koperative.h kcontinuation.h kerror.h kghelpers.h kenvironment.h \
- ksymbol.h kstring.h ktable.h kglibraries.h kpair.h kkeyword.h
+ koperative.h kcontinuation.h kerror.h kghelpers.h kvector.h \
+ kenvironment.h ksymbol.h kstring.h ktable.h kgpromises.h
kground.o: kground.c kstate.h klimits.h klisp.h kobject.h klispconf.h \
- ktoken.h kmem.h kground.h kghelpers.h kerror.h kpair.h kgc.h \
+ ktoken.h kmem.h kground.h kghelpers.h kerror.h kpair.h kgc.h kvector.h \
kapplicative.h koperative.h kcontinuation.h kenvironment.h ksymbol.h \
kstring.h ktable.h kgbooleans.h kgeqp.h kgequalp.h kgsymbols.h \
kgcontrol.h kgpairs_lists.h kgpair_mut.h kgenvironments.h kgenv_mut.h \
kgcombiners.h kgcontinuations.h kgencapsulations.h kgpromises.h \
kgkd_vars.h kgks_vars.h kgnumbers.h kgstrings.h kgchars.h kgports.h \
- kgbytevectors.h kgvectors.h kgtables.h kgsystem.h kgerrors.h kglibraries.h \
- kgffi.h keval.h krepl.h
+ kgbytevectors.h kgvectors.h kgtables.h kgsystem.h kgerrors.h \
+ kgkeywords.h kglibraries.h kgffi.h keval.h krepl.h
kgstrings.o: kgstrings.c kstate.h klimits.h klisp.h kobject.h klispconf.h \
ktoken.h kmem.h kapplicative.h koperative.h kcontinuation.h kerror.h \
kpair.h kgc.h ksymbol.h kstring.h kchar.h kvector.h kbytevector.h \
kghelpers.h kenvironment.h ktable.h kgstrings.h
kgsymbols.o: kgsymbols.c kstate.h klimits.h klisp.h kobject.h klispconf.h \
ktoken.h kmem.h kcontinuation.h kpair.h kgc.h kstring.h ksymbol.h \
- kerror.h kghelpers.h kapplicative.h koperative.h kenvironment.h ktable.h \
- kgsymbols.h
-kgkeywords.o: kgkeywords.c kgkeywords.h kstate.h klimits.h klisp.h kobject.h \
- klispconf.h ktoken.h kmem.h kcontinuation.h kpair.h kgc.h kstring.h \
- ksymbol.h kerror.h kghelpers.h kapplicative.h koperative.h kenvironment.h \
- ktable.h kkeyword.h
+ kerror.h kghelpers.h kvector.h kapplicative.h koperative.h \
+ kenvironment.h ktable.h kgsymbols.h
kgsystem.o: kgsystem.c kstate.h klimits.h klisp.h kobject.h klispconf.h \
- ktoken.h kmem.h kpair.h kgc.h kerror.h ksystem.h kghelpers.h \
- kapplicative.h koperative.h kcontinuation.h kenvironment.h ksymbol.h \
- kstring.h ktable.h kgsystem.h kinteger.h kmem.h imath.h kgc.h
+ ktoken.h kmem.h kpair.h kgc.h kerror.h ksystem.h kinteger.h imath.h \
+ kghelpers.h kvector.h kapplicative.h koperative.h kcontinuation.h \
+ kenvironment.h ksymbol.h kstring.h ktable.h kgsystem.h
kgtables.o: kgtables.c kstate.h klimits.h klisp.h kobject.h klispconf.h \
ktoken.h kmem.h kapplicative.h koperative.h kcontinuation.h kerror.h \
- kpair.h kgc.h kvector.h kbytevector.h kghelpers.h kenvironment.h \
- ksymbol.h kstring.h ktable.h kgtables.h
+ kpair.h kgc.h kghelpers.h kvector.h kenvironment.h ksymbol.h kstring.h \
+ ktable.h kgtables.h
kgvectors.o: kgvectors.c kstate.h klimits.h klisp.h kobject.h klispconf.h \
ktoken.h kmem.h kapplicative.h koperative.h kcontinuation.h kerror.h \
kpair.h kgc.h kvector.h kbytevector.h kghelpers.h kenvironment.h \
ksymbol.h kstring.h ktable.h kgvectors.h
kinteger.o: kinteger.c kinteger.h kobject.h klimits.h klisp.h klispconf.h \
kstate.h ktoken.h kmem.h imath.h kgc.h
-klisp.o: klisp.c klimits.h klisp.h kobject.h klispconf.h kstate.h \
+kkeyword.o: kkeyword.c kkeyword.h kobject.h klimits.h klisp.h klispconf.h \
+ kstate.h ktoken.h kmem.h kstring.h kgc.h
+klibrary.o: klibrary.c kobject.h klimits.h klisp.h klispconf.h kstate.h \
+ ktoken.h kmem.h klibrary.h kgc.h
+klisp.o: klisp.c klimits.h klisp.h kstate.h kobject.h klispconf.h \
ktoken.h kmem.h kauxlib.h kstring.h kcontinuation.h koperative.h \
kapplicative.h ksymbol.h kenvironment.h kport.h kread.h kwrite.h \
- kerror.h kpair.h kgc.h krepl.h kghelpers.h ktable.h
-kmem.o: kmem.c klisp.h kobject.h klimits.h klispconf.h kstate.h ktoken.h \
+ kerror.h kpair.h kgc.h krepl.h ksystem.h kghelpers.h kvector.h ktable.h
+kmem.o: kmem.c klisp.h kstate.h klimits.h kobject.h klispconf.h ktoken.h \
kmem.h kerror.h kpair.h kgc.h
kobject.o: kobject.c kobject.h klimits.h klisp.h klispconf.h
koperative.o: koperative.c koperative.h kobject.h klimits.h klisp.h \
@@ -301,8 +307,6 @@ kport.o: kport.c kport.h kobject.h klimits.h klisp.h klispconf.h kstate.h \
ktoken.h kmem.h kerror.h kpair.h kgc.h kstring.h kbytevector.h
kpromise.o: kpromise.c kobject.h klimits.h klisp.h klispconf.h kstate.h \
ktoken.h kmem.h kpromise.h kpair.h kgc.h
-klibrary.o: klibrary.c kobject.h klimits.h klisp.h klispconf.h kstate.h \
- ktoken.h kmem.h klibrary.h kgc.h
krational.o: krational.c krational.h kobject.h klimits.h klisp.h \
klispconf.h kstate.h ktoken.h kmem.h kinteger.h imath.h imrat.h kgc.h
kread.o: kread.c kread.h kobject.h klimits.h klisp.h klispconf.h kstate.h \
@@ -310,39 +314,37 @@ kread.o: kread.c kread.h kobject.h klimits.h klisp.h klispconf.h kstate.h \
kreal.o: kreal.c kreal.h kobject.h klimits.h klisp.h klispconf.h kstate.h \
ktoken.h kmem.h kinteger.h imath.h krational.h imrat.h kgc.h kpair.h \
kerror.h
-krepl.o: krepl.c klisp.h kobject.h klimits.h klispconf.h kstate.h \
+krepl.o: krepl.c klisp.h kstate.h klimits.h kobject.h klispconf.h \
ktoken.h kmem.h kcontinuation.h kenvironment.h kerror.h kpair.h kgc.h \
kread.h kwrite.h kstring.h krepl.h ksymbol.h kport.h ktable.h \
- kghelpers.h kapplicative.h koperative.h
-kstate.o: kstate.c klisp.h kobject.h klimits.h klispconf.h kstate.h \
- ktoken.h kmem.h kstring.h kpair.h kgc.h keval.h koperative.h \
- kapplicative.h kcontinuation.h kenvironment.h kground.h krepl.h \
- ksymbol.h kport.h ktable.h kbytevector.h kvector.h kghelpers.h kerror.h \
- kgerrors.h
+ kghelpers.h kvector.h kapplicative.h koperative.h
+kstate.o: kstate.c klisp.h klimits.h kstate.h kobject.h klispconf.h \
+ ktoken.h kmem.h kpair.h kgc.h keval.h koperative.h kapplicative.h \
+ kcontinuation.h kenvironment.h kground.h krepl.h ksymbol.h kstring.h \
+ kport.h ktable.h kbytevector.h kvector.h kghelpers.h kerror.h kgerrors.h
kstring.o: kstring.c kstring.h kobject.h klimits.h klisp.h klispconf.h \
kstate.h ktoken.h kmem.h kgc.h
ksymbol.o: ksymbol.c ksymbol.h kobject.h klimits.h klisp.h klispconf.h \
- kstate.h kmem.h kstring.h kgc.h
-kkeyword.o: kkeyword.c kkeyword.h kobject.h klimits.h klisp.h klispconf.h \
- kstate.h kmem.h kstring.h kgc.h
+ kstate.h ktoken.h kmem.h kstring.h kgc.h
ksystem.o: ksystem.c kobject.h klimits.h klisp.h klispconf.h kstate.h \
- ktoken.h kmem.h kerror.h kpair.h kgc.h ksystem.h
+ ktoken.h kmem.h kerror.h kpair.h kgc.h kinteger.h imath.h ksystem.h
ksystem.posix.o: ksystem.posix.c kobject.h klimits.h klisp.h klispconf.h \
- kstate.h ktoken.h kmem.h kinteger.h imath.h ksystem.h
+ kstate.h ktoken.h kmem.h kinteger.h imath.h kport.h ksystem.h
ksystem.win32.o: ksystem.win32.c kobject.h klimits.h klisp.h klispconf.h \
- kstate.h ktoken.h kmem.h kinteger.h imath.h ksystem.h
-ktable.o: ktable.c klisp.h kobject.h klimits.h klispconf.h kgc.h kstate.h \
+ kstate.h ktoken.h kmem.h kinteger.h imath.h kport.h ksystem.h
+ktable.o: ktable.c klisp.h kgc.h kobject.h klimits.h klispconf.h kstate.h \
ktoken.h kmem.h ktable.h kapplicative.h koperative.h kghelpers.h \
- kerror.h kpair.h kcontinuation.h kenvironment.h ksymbol.h kstring.h
+ kerror.h kpair.h kvector.h kcontinuation.h kenvironment.h ksymbol.h \
+ kstring.h
ktoken.o: ktoken.c ktoken.h kobject.h klimits.h klisp.h klispconf.h \
kstate.h kmem.h kinteger.h imath.h krational.h imrat.h kreal.h kpair.h \
- kgc.h kstring.h kbytevector.h ksymbol.h kerror.h kport.h kkeyword.h
+ kgc.h kstring.h kbytevector.h ksymbol.h kkeyword.h kerror.h kport.h
kvector.o: kvector.c kvector.h kobject.h klimits.h klisp.h klispconf.h \
kstate.h ktoken.h kmem.h kgc.h
kwrite.o: kwrite.c kwrite.h kobject.h klimits.h klisp.h klispconf.h \
kstate.h ktoken.h kmem.h kinteger.h imath.h krational.h imrat.h kreal.h \
kpair.h kgc.h kstring.h ksymbol.h kkeyword.h kerror.h ktable.h kport.h \
- kenvironment.h kbytevector.h kvector.h ktoken.h
+ kenvironment.h kbytevector.h kvector.h
imath.o: imath.c imath.h kobject.h klimits.h klisp.h klispconf.h kstate.h \
ktoken.h kmem.h kerror.h kpair.h kgc.h
imrat.o: imrat.c imrat.h imath.h kobject.h klimits.h klisp.h klispconf.h \
diff --git a/src/kbytevector.c b/src/kbytevector.c
@@ -28,6 +28,7 @@ TValue kbytevector_new_bs_g(klisp_State *K, bool m, const uint8_t *buf,
** Constructors for immutable bytevectors
*/
+/* XXX lock? */
/* main constructor for immutable bytevectors */
TValue kbytevector_new_bs_imm(klisp_State *K, const uint8_t *buf, uint32_t size)
{
@@ -39,7 +40,7 @@ TValue kbytevector_new_bs_imm(klisp_State *K, const uint8_t *buf, uint32_t size)
for (size1 = size; size1 >= step; size1 -= step) /* compute hash */
h = h ^ ((h<<5)+(h>>2)+ buf[size1-1]);
- for (GCObject *o = K->strt.hash[lmod(h, K->strt.size)];
+ for (GCObject *o = G(K)->strt.hash[lmod(h, G(K)->strt.size)];
o != NULL; o = o->gch.next) {
klisp_assert(o->gch.tt == K_TKEYWORD || o->gch.tt == K_TSYMBOL ||
o->gch.tt == K_TSTRING || o->gch.tt == K_TBYTEVECTOR);
@@ -49,7 +50,7 @@ TValue kbytevector_new_bs_imm(klisp_State *K, const uint8_t *buf, uint32_t size)
Bytevector *tb = (Bytevector *) o;
if (tb->size == size && (memcmp(buf, tb->b, size) == 0)) {
/* bytevector may be dead */
- if (isdead(K, o)) changewhite(o);
+ if (isdead(G(K), o)) changewhite(o);
return gc2bytevector(o);
}
}
@@ -66,7 +67,7 @@ TValue kbytevector_new_bs_imm(klisp_State *K, const uint8_t *buf, uint32_t size)
/* header + gc_fields */
/* can't use klispC_link, because strings use the next pointer
differently */
- new_bb->gct = klispC_white(K);
+ new_bb->gct = klispC_white(G(K));
new_bb->tt = K_TBYTEVECTOR;
new_bb->kflags = K_FLAG_IMMUTABLE;
new_bb->si = NULL;
@@ -82,7 +83,7 @@ TValue kbytevector_new_bs_imm(klisp_State *K, const uint8_t *buf, uint32_t size)
/* add to the string/symbol table (and link it) */
stringtable *tb;
- tb = &K->strt;
+ tb = &G(K)->strt;
h = lmod(h, tb->size);
new_bb->next = tb->hash[h]; /* chain new entry */
tb->hash[h] = (GCObject *)(new_bb);
@@ -108,8 +109,8 @@ TValue kbytevector_new_s(klisp_State *K, uint32_t size)
Bytevector *new_bb;
if (size == 0) {
- klisp_assert(ttisbytevector(K->empty_bytevector));
- return K->empty_bytevector;
+ klisp_assert(ttisbytevector(G(K)->empty_bytevector));
+ return G(K)->empty_bytevector;
}
new_bb = klispM_malloc(K, sizeof(Bytevector) + size);
@@ -130,8 +131,8 @@ TValue kbytevector_new_s(klisp_State *K, uint32_t size)
TValue kbytevector_new_bs(klisp_State *K, const uint8_t *buf, uint32_t size)
{
if (size == 0) {
- klisp_assert(ttisbytevector(K->empty_bytevector));
- return K->empty_bytevector;
+ klisp_assert(ttisbytevector(G(K)->empty_bytevector));
+ return G(K)->empty_bytevector;
}
TValue new_bb = kbytevector_new_s(K, size);
@@ -143,8 +144,8 @@ TValue kbytevector_new_bs(klisp_State *K, const uint8_t *buf, uint32_t size)
TValue kbytevector_new_sf(klisp_State *K, uint32_t size, uint8_t fill)
{
if (size == 0) {
- klisp_assert(ttisbytevector(K->empty_bytevector));
- return K->empty_bytevector;
+ klisp_assert(ttisbytevector(G(K)->empty_bytevector));
+ return G(K)->empty_bytevector;
}
TValue new_bb = kbytevector_new_s(K, size);
diff --git a/src/kenvironment.c b/src/kenvironment.c
@@ -123,8 +123,9 @@ void ktry_set_name(klisp_State *K, TValue obj, TValue sym)
that if this object receives a name it can pass on that
name to other objs, like applicatives to operatives &
some applicatives to objects */
+/* XXX lock? */
gcvalue(obj)->gch.kflags |= K_FLAG_HAS_NAME;
- TValue *node = klispH_set(K, tv2table(K->name_table), obj);
+ TValue *node = klispH_set(K, tv2table(G(K)->name_table), obj);
*node = sym;
/* TEMP: use this until we have a general mechanism to add
@@ -133,8 +134,9 @@ void ktry_set_name(klisp_State *K, TValue obj, TValue sym)
/* underlying is rooted by means of obj */
TValue underlying = kunwrap(obj);
while (kcan_have_name(underlying) && !khas_name(underlying)) {
+/* XXX lock? */
gcvalue(underlying)->gch.kflags |= K_FLAG_HAS_NAME;
- node = klispH_set(K, tv2table(K->name_table), underlying);
+ node = klispH_set(K, tv2table(G(K)->name_table), underlying);
*node = sym;
if (ttisapplicative(underlying))
underlying = kunwrap(underlying);
@@ -148,7 +150,8 @@ void ktry_set_name(klisp_State *K, TValue obj, TValue sym)
/* Assumes obj has a name */
TValue kget_name(klisp_State *K, TValue obj)
{
- const TValue *node = klispH_get(tv2table(K->name_table),
+/* XXX lock? */
+ const TValue *node = klispH_get(tv2table(G(K)->name_table),
obj);
klisp_assert(node != &kfree);
return *node;
diff --git a/src/kerror.c b/src/kerror.c
@@ -87,7 +87,7 @@ void klispE_throw_simple(klisp_State *K, char *msg)
krooted_tvs_push(K, error_obj);
clear_buffers(K); /* this pops both error_msg & error_obj */
/* call_cont protects error from gc */
- kcall_cont(K, K->error_cont, error_obj);
+ kcall_cont(K, G(K)->error_cont, error_obj);
}
/*
@@ -112,7 +112,7 @@ void klispE_throw_with_irritants(klisp_State *K, char *msg, TValue irritants)
krooted_tvs_push(K, error_obj);
clear_buffers(K); /* this pops both error_msg & error_obj */
/* call_cont protects error from gc */
- kcall_cont(K, K->error_cont, error_obj);
+ kcall_cont(K, G(K)->error_cont, error_obj);
}
void klispE_throw_system_error_with_irritants(
@@ -122,7 +122,7 @@ void klispE_throw_system_error_with_irritants(
irritants);
krooted_tvs_push(K, error_obj);
clear_buffers(K);
- kcall_cont(K, K->system_error_cont, error_obj);
+ kcall_cont(K, G(K)->system_error_cont, error_obj);
}
/* The array symbolic_error_codes[] assigns locale and target
diff --git a/src/keval.c b/src/keval.c
@@ -192,7 +192,8 @@ void keval_ofn(klisp_State *K)
/* init continuation names */
void kinit_eval_cont_names(klisp_State *K)
{
- Table *t = tv2table(K->cont_name_table);
+/* XXX lock? */
+ Table *t = tv2table(G(K)->cont_name_table);
add_cont_name(K, t, do_eval_ls, "eval-argument-list");
add_cont_name(K, t, do_combine_operator, "eval-combine-operator");
add_cont_name(K, t, do_combine_operands, "eval-combine-operands");
diff --git a/src/kgbooleans.c b/src/kgbooleans.c
@@ -194,7 +194,7 @@ void Sandp_Sorp(klisp_State *K)
/* init ground */
void kinit_booleans_ground_env(klisp_State *K)
{
- TValue ground_env = K->ground_env;
+ TValue ground_env = G(K)->ground_env;
TValue symbol, value;
/* 4.1.1 boolean? */
@@ -212,9 +212,10 @@ void kinit_booleans_ground_env(klisp_State *K)
add_operative(K, ground_env, "$or?", Sandp_Sorp, 2, symbol, KTRUE);
}
+/* XXX lock? */
/* init continuation names */
void kinit_booleans_cont_names(klisp_State *K)
{
- Table *t = tv2table(K->cont_name_table);
+ Table *t = tv2table(G(K)->cont_name_table);
add_cont_name(K, t, do_Sandp_Sorp, "eval-booleans");
}
diff --git a/src/kgbytevectors.c b/src/kgbytevectors.c
@@ -200,7 +200,7 @@ void bytevector_copy(klisp_State *K)
TValue new_bytevector;
/* the if isn't strictly necessary but it's clearer this way */
- if (tv_equal(bytevector, K->empty_bytevector)) {
+ if (tv_equal(bytevector, G(K)->empty_bytevector)) {
new_bytevector = bytevector;
} else {
new_bytevector = kbytevector_new_bs(K, kbytevector_buf(bytevector),
@@ -230,7 +230,7 @@ void bytevector_copyB(klisp_State *K)
}
if (!tv_equal(bytevector1, bytevector2) &&
- !tv_equal(bytevector1, K->empty_bytevector)) {
+ !tv_equal(bytevector1, G(K)->empty_bytevector)) {
memcpy(kbytevector_buf(bytevector2),
kbytevector_buf(bytevector1),
kbytevector_size(bytevector1));
@@ -279,7 +279,7 @@ void bytevector_copy_partial(klisp_State *K)
TValue new_bytevector;
/* the if isn't strictly necessary but it's clearer this way */
if (size == 0) {
- new_bytevector = K->empty_bytevector;
+ new_bytevector = G(K)->empty_bytevector;
} else {
new_bytevector = kbytevector_new_bs(K, kbytevector_buf(bytevector)
+ start, size);
@@ -409,7 +409,7 @@ void bytevector_to_immutable_bytevector(klisp_State *K)
/* init ground */
void kinit_bytevectors_ground_env(klisp_State *K)
{
- TValue ground_env = K->ground_env;
+ TValue ground_env = G(K)->ground_env;
TValue symbol, value;
/*
diff --git a/src/kgc.c b/src/kgc.c
@@ -52,12 +52,12 @@
#define VALUEWEAK bitmask(VALUEWEAKBIT)
/* this one is klisp specific */
-#define markvaluearray(k, a, s) ({ \
+#define markvaluearray(g, a, s) ({ \
TValue *array_ = (a); \
int32_t size_ = (s); \
for(int32_t i_ = 0; i_ < size_; i_++, array_++) { \
TValue mva_obj_ = *array_; \
- markvalue(k, mva_obj_); \
+ markvalue(g, mva_obj_); \
}})
#define markvalue(k,o) { checkconsistency(o); \
@@ -76,9 +76,9 @@ static void removeentry (Node *n) {
gkey(n)->this = gc2deadkey(gcvalue(gkey(n)->this));
}
-static void reallymarkobject (klisp_State *K, GCObject *o)
+static void reallymarkobject (global_State *g, GCObject *o)
{
- klisp_assert(iswhite(o) && !isdead(K, o));
+ klisp_assert(iswhite(o) && !isdead(g, o));
white2gray(o);
/* klisp: most of klisp have the same structure, but conserve the switch
just in case. */
@@ -115,8 +115,9 @@ static void reallymarkobject (klisp_State *K, GCObject *o)
case K_TFPORT:
case K_TMPORT:
case K_TLIBRARY:
- o->gch.gclist = K->gray;
- K->gray = o;
+ case K_TTHREAD:
+ o->gch.gclist = g->gray;
+ g->gray = o;
break;
default:
/* shouldn't happen */
@@ -172,7 +173,7 @@ size_t klispC_separateudata (lua_State *L, int all) {
#endif
-static int32_t traversetable (klisp_State *K, Table *h) {
+static int32_t traversetable (global_State *g, Table *h) {
int32_t i;
TValue tv = gc2table(h);
int32_t weakkey = ktable_has_weak_keys(tv)? 1 : 0;
@@ -182,14 +183,14 @@ static int32_t traversetable (klisp_State *K, Table *h) {
h->gct &= ~(KEYWEAK | VALUEWEAK); /* clear bits */
h->gct |= cast(uint16_t, (weakkey << KEYWEAKBIT) |
(weakvalue << VALUEWEAKBIT));
- h->gclist = K->weak; /* must be cleared after GC, ... */
- K->weak = obj2gco(h); /* ... so put in the appropriate list */
+ h->gclist = g->weak; /* must be cleared after GC, ... */
+ g->weak = obj2gco(h); /* ... so put in the appropriate list */
}
if (weakkey && weakvalue) return 1;
if (!weakvalue) {
i = h->sizearray;
while (i--)
- markvalue(K, h->array[i]);
+ markvalue(g, h->array[i]);
}
i = sizenode(h);
while (i--) {
@@ -200,8 +201,8 @@ static int32_t traversetable (klisp_State *K, Table *h) {
removeentry(n); /* remove empty entries */
else {
klisp_assert(!ttisfree(gkey(n)->this));
- if (!weakkey) markvalue(K, gkey(n)->this);
- if (!weakvalue) markvalue(K, gval(n));
+ if (!weakkey) markvalue(g, gkey(n)->this);
+ if (!weakvalue) markvalue(g, gval(n));
}
}
return weakkey || weakvalue;
@@ -237,14 +238,14 @@ static void traverseproto (global_State *g, Proto *f) {
** traverse one gray object, turning it to black.
** Returns `quantity' traversed.
*/
-static int32_t propagatemark (klisp_State *K) {
- GCObject *o = K->gray;
- K->gray = o->gch.gclist;
+static int32_t propagatemark (global_State *g) {
+ GCObject *o = g->gray;
+ g->gray = o->gch.gclist;
klisp_assert(isgray(o));
gray2black(o);
/* all types have si pointers */
if (o->gch.si != NULL) {
- markobject(K, o->gch.si);
+ markobject(g, o->gch.si);
}
uint8_t type = o->gch.tt;
@@ -253,107 +254,132 @@ static int32_t propagatemark (klisp_State *K) {
case K_TBIGINT: bigints & bigrats are never gray */
case K_TPAIR: {
Pair *p = cast(Pair *, o);
- markvalue(K, p->mark);
- markvalue(K, p->car);
- markvalue(K, p->cdr);
+ markvalue(g, p->mark);
+ markvalue(g, p->car);
+ markvalue(g, p->cdr);
return sizeof(Pair);
}
case K_TSYMBOL: {
Symbol *s = cast(Symbol *, o);
- markvalue(K, s->str);
+ markvalue(g, s->str);
return sizeof(Symbol);
}
case K_TKEYWORD: {
Keyword *k = cast(Keyword *, o);
- markvalue(K, k->str);
+ markvalue(g, k->str);
return sizeof(Keyword);
}
case K_TSTRING: {
String *s = cast(String *, o);
- markvalue(K, s->mark);
+ markvalue(g, s->mark);
return sizeof(String) + (s->size + 1 * sizeof(char));
}
case K_TENVIRONMENT: {
Environment *e = cast(Environment *, o);
- markvalue(K, e->mark);
- markvalue(K, e->parents);
- markvalue(K, e->bindings);
- markvalue(K, e->keyed_node);
- markvalue(K, e->keyed_parents);
+ markvalue(g, e->mark);
+ markvalue(g, e->parents);
+ markvalue(g, e->bindings);
+ markvalue(g, e->keyed_node);
+ markvalue(g, e->keyed_parents);
return sizeof(Environment);
}
case K_TCONTINUATION: {
Continuation *c = cast(Continuation *, o);
- markvalue(K, c->mark);
- markvalue(K, c->parent);
- markvalue(K, c->comb);
- markvaluearray(K, c->extra, c->extra_size);
+ markvalue(g, c->mark);
+ markvalue(g, c->parent);
+ markvalue(g, c->comb);
+ markvaluearray(g, c->extra, c->extra_size);
return sizeof(Continuation) + sizeof(TValue) * c->extra_size;
}
case K_TOPERATIVE: {
Operative *op = cast(Operative *, o);
- markvaluearray(K, op->extra, op->extra_size);
+ markvaluearray(g, op->extra, op->extra_size);
return sizeof(Operative) + sizeof(TValue) * op->extra_size;
}
case K_TAPPLICATIVE: {
Applicative *a = cast(Applicative *, o);
- markvalue(K, a->underlying);
+ markvalue(g, a->underlying);
return sizeof(Applicative);
}
case K_TENCAPSULATION: {
Encapsulation *e = cast(Encapsulation *, o);
- markvalue(K, e->key);
- markvalue(K, e->value);
+ markvalue(g, e->key);
+ markvalue(g, e->value);
return sizeof(Encapsulation);
}
case K_TPROMISE: {
Promise *p = cast(Promise *, o);
- markvalue(K, p->node);
+ markvalue(g, p->node);
return sizeof(Promise);
}
case K_TTABLE: {
Table *h = cast(Table *, o);
- if (traversetable(K, h)) /* table is weak? */
+ if (traversetable(g, h)) /* table is weak? */
black2gray(o); /* keep it gray */
return sizeof(Table) + sizeof(TValue) * h->sizearray +
sizeof(Node) * sizenode(h);
}
case K_TERROR: {
Error *e = cast(Error *, o);
- markvalue(K, e->who);
- markvalue(K, e->cont);
- markvalue(K, e->msg);
- markvalue(K, e->irritants);
+ markvalue(g, e->who);
+ markvalue(g, e->cont);
+ markvalue(g, e->msg);
+ markvalue(g, e->irritants);
return sizeof(Error);
}
case K_TBYTEVECTOR: {
Bytevector *b = cast(Bytevector *, o);
- markvalue(K, b->mark);
+ markvalue(g, b->mark);
return sizeof(Bytevector) + b->size * sizeof(uint8_t);
}
case K_TFPORT: {
FPort *p = cast(FPort *, o);
- markvalue(K, p->filename);
+ markvalue(g, p->filename);
return sizeof(FPort);
}
case K_TMPORT: {
MPort *p = cast(MPort *, o);
- markvalue(K, p->filename);
- markvalue(K, p->buf);
+ markvalue(g, p->filename);
+ markvalue(g, p->buf);
return sizeof(MPort);
}
case K_TVECTOR: {
Vector *v = cast(Vector *, o);
- markvalue(K, v->mark);
- markvaluearray(K, v->array, v->sizearray);
+ markvalue(g, v->mark);
+ markvaluearray(g, v->array, v->sizearray);
return sizeof(Vector) + v->sizearray * sizeof(TValue);
}
case K_TLIBRARY: {
Library *l = cast(Library *, o);
- markvalue(K, l->env);
- markvalue(K, l->exp_list);
+ markvalue(g, l->env);
+ markvalue(g, l->exp_list);
return sizeof(Library);
}
+ case K_TTHREAD: {
+ klisp_State *K = cast(klisp_State *, o);
+
+ markvalue(g, K->curr_cont);
+ markvalue(g, K->next_obj);
+ markvalue(g, K->next_value);
+ markvalue(g, K->next_env);
+ markvalue(g, K->next_si);
+ /* NOTE: next_x_params is protected by next_obj */
+
+ markvalue(g, K->shared_dict);
+ markvalue(g, K->curr_port);
+
+ /* Mark all objects in the auxiliary stack,
+ (all valid indexes are below top) and all the objects in
+ the two protected areas */
+ markvaluearray(g, K->sbuf, K->stop);
+ markvaluearray(g, K->rooted_tvs_buf, K->rooted_tvs_top);
+ /* the area protecting variables is an array of type TValue *[] */
+ TValue **ptr = K->rooted_vars_buf;
+ for (int i = 0, top = K->rooted_vars_top; i < top; i++, ptr++) {
+ markvalue(g, **ptr);
+ }
+ return sizeof(klisp_State) + (sizeof(TValue) * K->stop);
+ }
default:
fprintf(stderr, "Unknown GCObject type (in GC propagate): %d\n",
type);
@@ -362,9 +388,9 @@ static int32_t propagatemark (klisp_State *K) {
}
-static size_t propagateall (klisp_State *K) {
+static size_t propagateall (global_State *g) {
size_t m = 0;
- while (K->gray) m += propagatemark(K);
+ while (g->gray) m += propagatemark(g);
return m;
}
@@ -442,19 +468,19 @@ static void freeobj (klisp_State *K, GCObject *o) {
/* The string will be freed before/after */
/* symbols with no source info are in the string/symbol table */
if (ttisnil(ktry_get_si(K, gc2sym(o))))
- K->strt.nuse--;
+ G(K)->strt.nuse--;
klispM_free(K, (Symbol *)o);
break;
case K_TKEYWORD:
/* keywords are in the string table */
/* The string will be freed before/after */
- K->strt.nuse--;
+ G(K)->strt.nuse--;
klispM_free(K, (Keyword *)o);
break;
case K_TSTRING:
/* immutable strings are in the string/symbol table */
if (kstring_immutablep(gc2str(o)))
- K->strt.nuse--;
+ G(K)->strt.nuse--;
klispM_freemem(K, o, sizeof(String)+o->str.size+1);
break;
case K_TENVIRONMENT:
@@ -486,7 +512,7 @@ static void freeobj (klisp_State *K, GCObject *o) {
case K_TBYTEVECTOR:
/* immutable bytevectors are in the string/symbol table */
if (kbytevector_immutablep(gc2str(o)))
- K->strt.nuse--;
+ G(K)->strt.nuse--;
klispM_freemem(K, o, sizeof(Bytevector)+o->bytevector.size);
break;
case K_TFPORT:
@@ -509,6 +535,12 @@ static void freeobj (klisp_State *K, GCObject *o) {
case K_TLIBRARY:
klispM_free(K, (Library *)o);
break;
+ case K_TTHREAD: {
+ klisp_assert((klisp_State *) o != K &&
+ (klisp_State *) o != G(K)->mainthread);
+ klispT_freethread(K, (klisp_State *) o);
+ break;
+ }
default:
/* shouldn't happen */
fprintf(stderr, "Unknown GCObject type (in GC free): %d\n",
@@ -525,17 +557,18 @@ static void freeobj (klisp_State *K, GCObject *o) {
static GCObject **sweeplist (klisp_State *K, GCObject **p, uint32_t count)
{
GCObject *curr;
- int deadmask = otherwhite(K);
+ global_State *g = G(K);
+ int deadmask = otherwhite(g);
while ((curr = *p) != NULL && count-- > 0) {
if ((curr->gch.gct ^ WHITEBITS) & deadmask) { /* not dead? */
- klisp_assert(!isdead(K, curr) || testbit(curr->gch.gct, FIXEDBIT));
- makewhite(K, curr); /* make it white (for next cycle) */
+ klisp_assert(!isdead(g, curr) || testbit(curr->gch.gct, FIXEDBIT));
+ makewhite(g, curr); /* make it white (for next cycle) */
p = &curr->gch.next;
} else { /* must erase `curr' */
- klisp_assert(isdead(K, curr) || deadmask == bitmask(SFIXEDBIT));
+ klisp_assert(isdead(g, curr) || deadmask == bitmask(SFIXEDBIT));
*p = curr->gch.next;
- if (curr == K->rootgc) /* is the first element of the list? */
- K->rootgc = curr->gch.next; /* adjust first */
+ if (curr == g->rootgc) /* is the first element of the list? */
+ g->rootgc = curr->gch.next; /* adjust first */
freeobj(K, curr);
}
}
@@ -543,10 +576,11 @@ static GCObject **sweeplist (klisp_State *K, GCObject **p, uint32_t count)
}
static void checkSizes (klisp_State *K) {
+ global_State *g = G(K);
/* check size of string/symbol hash */
- if (K->strt.nuse < cast(uint32_t , K->strt.size/4) &&
- K->strt.size > MINSTRTABSIZE*2)
- klispS_resize(K, K->strt.size/2); /* table is too big */
+ if (g->strt.nuse < cast(uint32_t , g->strt.size/4) &&
+ g->strt.size > MINSTRTABSIZE*2)
+ klispS_resize(K, g->strt.size/2); /* table is too big */
#if 0 /* not used in klisp */
/* check size of buffer */
if (luaZ_sizebuffer(&g->buff) > LUA_MINBUFFER*2) { /* buffer too big? */
@@ -598,89 +632,74 @@ void klispC_callGCTM (lua_State *L) {
/* This still leaves allocated objs in K, namely the
arrays that aren't TValues */
void klispC_freeall (klisp_State *K) {
+ global_State *g = G(K);
/* mask to collect all elements */
- K->currentwhite = WHITEBITS | bitmask(SFIXEDBIT);
- sweepwholelist(K, &K->rootgc);
+ g->currentwhite = WHITEBITS | bitmask(SFIXEDBIT);
+ sweepwholelist(K, &g->rootgc);
/* free all keyword/symbol/string/bytevectors lists */
- for (int32_t i = 0; i < K->strt.size; i++)
- sweepwholelist(K, &K->strt.hash[i]);
+ for (int32_t i = 0; i < g->strt.size; i++)
+ sweepwholelist(K, &g->strt.hash[i]);
}
-
/* mark root set */
static void markroot (klisp_State *K) {
- K->gray = NULL;
- K->grayagain = NULL;
- K->weak = NULL;
+ global_State *g = G(K);
+ g->gray = NULL;
+ g->grayagain = NULL;
+ g->weak = NULL;
/* TEMP: this is quite awful, think of other way to do this */
/* MAYBE: some of these could be FIXED */
- markvalue(K, K->name_table);
- markvalue(K, K->cont_name_table);
- markvalue(K, K->curr_cont);
- markvalue(K, K->next_obj);
- markvalue(K, K->next_value);
- markvalue(K, K->next_env);
- markvalue(K, K->next_si);
- /* NOTE: next_x_params is protected by next_obj */
- markvalue(K, K->eval_op);
- markvalue(K, K->list_app);
- markvalue(K, K->memoize_app);
- markvalue(K, K->ground_env);
- markvalue(K, K->module_params_sym);
- markvalue(K, K->root_cont);
- markvalue(K, K->error_cont);
- markvalue(K, K->system_error_cont);
-
- markvalue(K, K->kd_in_port_key);
- markvalue(K, K->kd_out_port_key);
- markvalue(K, K->kd_error_port_key);
- markvalue(K, K->kd_strict_arith_key);
- markvalue(K, K->empty_string);
- markvalue(K, K->empty_bytevector);
- markvalue(K, K->empty_vector);
-
- markvalue(K, K->ktok_lparen);
- markvalue(K, K->ktok_rparen);
- markvalue(K, K->ktok_dot);
- markvalue(K, K->ktok_sexp_comment);
- markvalue(K, K->shared_dict);
-
- markvalue(K, K->curr_port);
-
- markvalue(K, K->require_path);
- markvalue(K, K->require_table);
-
- markvalue(K, K->libraries_registry);
-
- /* Mark all objects in the auxiliary stack,
- (all valid indexes are below top) and all the objects in
- the two protected areas */
- markvaluearray(K, K->sbuf, K->stop);
- markvaluearray(K, K->rooted_tvs_buf, K->rooted_tvs_top);
- /* the area protecting variables is an array of type TValue *[] */
- TValue **ptr = K->rooted_vars_buf;
- for (int i = 0, top = K->rooted_vars_top; i < top; i++, ptr++) {
- markvalue(K, **ptr);
- }
-
- K->gcstate = GCSpropagate;
+ markobject(g, g->mainthread);
+
+ markvalue(g, g->name_table);
+ markvalue(g, g->cont_name_table);
+
+ markvalue(g, g->eval_op);
+ markvalue(g, g->list_app);
+ markvalue(g, g->memoize_app);
+ markvalue(g, g->ground_env);
+ markvalue(g, g->module_params_sym);
+ markvalue(g, g->root_cont);
+ markvalue(g, g->error_cont);
+ markvalue(g, g->system_error_cont);
+
+ markvalue(g, g->kd_in_port_key);
+ markvalue(g, g->kd_out_port_key);
+ markvalue(g, g->kd_error_port_key);
+ markvalue(g, g->kd_strict_arith_key);
+ markvalue(g, g->empty_string);
+ markvalue(g, g->empty_bytevector);
+ markvalue(g, g->empty_vector);
+
+ markvalue(g, g->ktok_lparen);
+ markvalue(g, g->ktok_rparen);
+ markvalue(g, g->ktok_dot);
+ markvalue(g, g->ktok_sexp_comment);
+
+ markvalue(g, g->require_path);
+ markvalue(g, g->require_table);
+
+ markvalue(g, g->libraries_registry);
+
+ g->gcstate = GCSpropagate;
}
static void atomic (klisp_State *K) {
+ global_State *g = G(K);
size_t udsize; /* total size of userdata to be finalized */
/* traverse objects caught by write barrier */
- propagateall(K);
+ propagateall(g);
/* remark weak tables */
- K->gray = K->weak;
- K->weak = NULL;
- propagateall(K);
+ g->gray = g->weak;
+ g->weak = NULL;
+ propagateall(g);
/* remark gray again */
- K->gray = K->grayagain;
- K->grayagain = NULL;
- propagateall(K);
+ g->gray = g->grayagain;
+ g->grayagain = NULL;
+ propagateall(g);
udsize = 0; /* to init var 'till we add user data */
#if 0 /* keep around */
@@ -688,49 +707,50 @@ static void atomic (klisp_State *K) {
marktmu(g); /* mark `preserved' userdata */
udsize += propagateall(g); /* remark, to propagate `preserveness' */
#endif
- cleartable(K->weak); /* remove collected objects from weak tables */
+ cleartable(g->weak); /* remove collected objects from weak tables */
/* flip current white */
- K->currentwhite = cast(uint16_t, otherwhite(K));
- K->sweepstrgc = 0;
- K->sweepgc = &K->rootgc;
- K->gcstate = GCSsweepstring;
- K->estimate = K->totalbytes - udsize; /* first estimate */
+ g->currentwhite = cast(uint16_t, otherwhite(g));
+ g->sweepstrgc = 0;
+ g->sweepgc = &g->rootgc;
+ g->gcstate = GCSsweepstring;
+ g->estimate = g->totalbytes - udsize; /* first estimate */
}
static int32_t singlestep (klisp_State *K) {
- switch (K->gcstate) {
+ global_State *g = G(K);
+ switch (g->gcstate) {
case GCSpause: {
markroot(K); /* start a new collection */
return 0;
}
case GCSpropagate: {
- if (K->gray)
- return propagatemark(K);
+ if (g->gray)
+ return propagatemark(g);
else { /* no more `gray' objects */
atomic(K); /* finish mark phase */
return 0;
}
}
case GCSsweepstring: {
- uint32_t old = K->totalbytes;
- sweepwholelist(K, &K->strt.hash[K->sweepstrgc++]);
- if (K->sweepstrgc >= K->strt.size) /* nothing more to sweep? */
- K->gcstate = GCSsweep; /* end sweep-string phase */
- klisp_assert(old >= K->totalbytes);
- K->estimate -= old - K->totalbytes;
+ uint32_t old = g->totalbytes;
+ sweepwholelist(K, &g->strt.hash[g->sweepstrgc++]);
+ if (g->sweepstrgc >= g->strt.size) /* nothing more to sweep? */
+ g->gcstate = GCSsweep; /* end sweep-string phase */
+ klisp_assert(old >= g->totalbytes);
+ g->estimate -= old - g->totalbytes;
return GCSWEEPCOST;
}
case GCSsweep: {
- uint32_t old = K->totalbytes;
- K->sweepgc = sweeplist(K, K->sweepgc, GCSWEEPMAX);
- if (*K->sweepgc == NULL) { /* nothing more to sweep? */
+ uint32_t old = g->totalbytes;
+ g->sweepgc = sweeplist(K, g->sweepgc, GCSWEEPMAX);
+ if (*g->sweepgc == NULL) { /* nothing more to sweep? */
checkSizes(K);
- K->gcstate = GCSfinalize; /* end sweep phase */
+ g->gcstate = GCSfinalize; /* end sweep phase */
}
- klisp_assert(old >= K->totalbytes);
- K->estimate -= old - K->totalbytes;
+ klisp_assert(old >= g->totalbytes);
+ g->estimate -= old - g->totalbytes;
return GCSWEEPMAX*GCSWEEPCOST;
}
case GCSfinalize: {
@@ -743,8 +763,8 @@ static int32_t singlestep (klisp_State *K) {
}
else {
#endif
- K->gcstate = GCSpause; /* end collection */
- K->gcdept = 0;
+ g->gcstate = GCSpause; /* end collection */
+ g->gcdept = 0;
return 0;
#if 0
}
@@ -756,55 +776,57 @@ static int32_t singlestep (klisp_State *K) {
void klispC_step (klisp_State *K) {
- int32_t lim = (GCSTEPSIZE/100) * K->gcstepmul;
+ global_State *g = G(K);
+ int32_t lim = (GCSTEPSIZE/100) * g->gcstepmul;
if (lim == 0)
lim = (UINT32_MAX-1)/2; /* no limit */
- K->gcdept += K->totalbytes - K->GCthreshold;
+ g->gcdept += g->totalbytes - g->GCthreshold;
do {
lim -= singlestep(K);
- if (K->gcstate == GCSpause)
+ if (g->gcstate == GCSpause)
break;
} while (lim > 0);
- if (K->gcstate != GCSpause) {
- if (K->gcdept < GCSTEPSIZE) {
- K->GCthreshold = K->totalbytes + GCSTEPSIZE;
+ if (g->gcstate != GCSpause) {
+ if (g->gcdept < GCSTEPSIZE) {
+ g->GCthreshold = g->totalbytes + GCSTEPSIZE;
/* - lim/g->gcstepmul;*/
} else {
- K->gcdept -= GCSTEPSIZE;
- K->GCthreshold = K->totalbytes;
+ g->gcdept -= GCSTEPSIZE;
+ g->GCthreshold = g->totalbytes;
}
} else {
- klisp_assert(K->totalbytes >= K->estimate);
- setthreshold(K);
+ klisp_assert(g->totalbytes >= g->estimate);
+ setthreshold(g);
}
}
void klispC_fullgc (klisp_State *K) {
- if (K->gcstate <= GCSpropagate) {
+ global_State *g = G(K);
+ if (g->gcstate <= GCSpropagate) {
/* reset sweep marks to sweep all elements (returning them to white) */
- K->sweepstrgc = 0;
- K->sweepgc = &K->rootgc;
+ g->sweepstrgc = 0;
+ g->sweepgc = &g->rootgc;
/* reset other collector lists */
- K->gray = NULL;
- K->grayagain = NULL;
- K->weak = NULL;
- K->gcstate = GCSsweepstring;
+ g->gray = NULL;
+ g->grayagain = NULL;
+ g->weak = NULL;
+ g->gcstate = GCSsweepstring;
}
- klisp_assert(K->gcstate != GCSpause && K->gcstate != GCSpropagate);
+ klisp_assert(g->gcstate != GCSpause && g->gcstate != GCSpropagate);
/* finish any pending sweep phase */
- while (K->gcstate != GCSfinalize) {
- klisp_assert(K->gcstate == GCSsweepstring || K->gcstate == GCSsweep);
+ while (g->gcstate != GCSfinalize) {
+ klisp_assert(g->gcstate == GCSsweepstring || g->gcstate == GCSsweep);
singlestep(K);
}
markroot(K);
- while (K->gcstate != GCSpause) {
+ while (g->gcstate != GCSpause) {
singlestep(K);
}
- setthreshold(K);
+ setthreshold(g);
}
/* TODO: make all code using mutation to call these,
@@ -814,32 +836,35 @@ void klispC_fullgc (klisp_State *K) {
made before assigning to a GC guarded variable, or pushed in a GC
guarded stack! */
void klispC_barrierf (klisp_State *K, GCObject *o, GCObject *v) {
- klisp_assert(isblack(o) && iswhite(v) && !isdead(K, v) && !isdead(K, o));
- klisp_assert(K->gcstate != GCSfinalize && K->gcstate != GCSpause);
+ global_State *g = G(K);
+ klisp_assert(isblack(o) && iswhite(v) && !isdead(g, v) && !isdead(g, o));
+ klisp_assert(g->gcstate != GCSfinalize && g->gcstate != GCSpause);
klisp_assert(o->gch.tt != K_TTABLE);
/* must keep invariant? */
- if (K->gcstate == GCSpropagate)
- reallymarkobject(K, v); /* restore invariant */
+ if (g->gcstate == GCSpropagate)
+ reallymarkobject(g, v); /* restore invariant */
else /* don't mind */
- makewhite(K, o); /* mark as white just to avoid other barriers */
+ makewhite(g, o); /* mark as white just to avoid other barriers */
}
void klispC_barrierback (klisp_State *K, Table *t) {
+ global_State *g = G(K);
GCObject *o = obj2gco(t);
- klisp_assert(isblack(o) && !isdead(K, o));
- klisp_assert(K->gcstate != GCSfinalize && K->gcstate != GCSpause);
+ klisp_assert(isblack(o) && !isdead(g, o));
+ klisp_assert(g->gcstate != GCSfinalize && g->gcstate != GCSpause);
black2gray(o); /* make table gray (again) */
- t->gclist = K->grayagain;
- K->grayagain = o;
+ t->gclist = g->grayagain;
+ g->grayagain = o;
}
/* NOTE: kflags is added for klisp */
/* NOTE: symbols, keywords, immutable strings and immutable bytevectors do
this "by hand", they don't call this */
void klispC_link (klisp_State *K, GCObject *o, uint8_t tt, uint8_t kflags) {
- o->gch.next = K->rootgc;
- K->rootgc = o;
- o->gch.gct = klispC_white(K);
+ global_State *g = G(K);
+ o->gch.next = g->rootgc;
+ g->rootgc = o;
+ o->gch.gct = klispC_white(g);
o->gch.tt = tt;
o->gch.kflags = kflags;
o->gch.si = NULL;
diff --git a/src/kgchars.c b/src/kgchars.c
@@ -186,7 +186,7 @@ void digit_to_char(klisp_State *K)
/* init ground */
void kinit_chars_ground_env(klisp_State *K)
{
- TValue ground_env = K->ground_env;
+ TValue ground_env = G(K)->ground_env;
TValue symbol, value;
/*
diff --git a/src/kgcombiners.c b/src/kgcombiners.c
@@ -585,7 +585,7 @@ void array_map(klisp_State *K)
/* init ground */
void kinit_combiners_ground_env(klisp_State *K)
{
- TValue ground_env = K->ground_env;
+ TValue ground_env = G(K)->ground_env;
TValue symbol, value;
/* 4.10.1 operative? */
@@ -619,10 +619,11 @@ void kinit_combiners_ground_env(klisp_State *K)
p2tv(kcombinerp));
}
+/* XXX lock? */
/* init continuation names */
void kinit_combiners_cont_names(klisp_State *K)
{
- Table *t = tv2table(K->cont_name_table);
+ Table *t = tv2table(G(K)->cont_name_table);
add_cont_name(K, t, do_vau, "$vau-bind!-eval");
diff --git a/src/kgcontinuations.c b/src/kgcontinuations.c
@@ -236,13 +236,13 @@ void kgexit(klisp_State *K)
/* TODO: look out for guards and dynamic variables */
/* should be probably handled in kcall_cont() */
- kcall_cont(K, K->root_cont, obj);
+ kcall_cont(K, G(K)->root_cont, obj);
}
/* init ground */
void kinit_continuations_ground_env(klisp_State *K)
{
- TValue ground_env = K->ground_env;
+ TValue ground_env = G(K)->ground_env;
TValue symbol, value;
/* 7.1.1 continuation? */
@@ -260,13 +260,13 @@ void kinit_continuations_ground_env(klisp_State *K)
add_applicative(K, ground_env, "continuation->applicative",
continuation_applicative, 0);
/* 7.2.6 root-continuation */
- klisp_assert(ttiscontinuation(K->root_cont));
+ klisp_assert(ttiscontinuation(G(K)->root_cont));
add_value(K, ground_env, "root-continuation",
- K->root_cont);
+ G(K)->root_cont);
/* 7.2.7 error-continuation */
- klisp_assert(ttiscontinuation(K->error_cont));
+ klisp_assert(ttiscontinuation(G(K)->error_cont));
add_value(K, ground_env, "error-continuation",
- K->error_cont);
+ G(K)->error_cont);
/* 7.3.1 apply-continuation */
add_applicative(K, ground_env, "apply-continuation", apply_continuation,
0);
@@ -281,10 +281,11 @@ void kinit_continuations_ground_env(klisp_State *K)
0);
}
+/* XXX lock? */
/* init continuation names */
void kinit_continuations_cont_names(klisp_State *K)
{
- Table *t = tv2table(K->cont_name_table);
+ Table *t = tv2table(G(K)->cont_name_table);
add_cont_name(K, t, do_extended_cont, "extended-cont");
}
diff --git a/src/kgcontrol.c b/src/kgcontrol.c
@@ -551,7 +551,7 @@ void Swhen_Sunless(klisp_State *K)
/* init ground */
void kinit_control_ground_env(klisp_State *K)
{
- TValue ground_env = K->ground_env;
+ TValue ground_env = G(K)->ground_env;
TValue symbol, value;
/* 4.5.1 inert? */
@@ -579,10 +579,11 @@ void kinit_control_ground_env(klisp_State *K)
b2tv(false));
}
+/* XXX lock? */
/* init continuation names */
void kinit_control_cont_names(klisp_State *K)
{
- Table *t = tv2table(K->cont_name_table);
+ Table *t = tv2table(G(K)->cont_name_table);
add_cont_name(K, t, do_select_clause, "select-clause");
add_cont_name(K, t, do_Swhen_Sunless, "conditional-eval-sequence");
diff --git a/src/kgencapsulations.c b/src/kgencapsulations.c
@@ -98,7 +98,7 @@ void make_encapsulation_type(klisp_State *K)
/* init ground */
void kinit_encapsulations_ground_env(klisp_State *K)
{
- TValue ground_env = K->ground_env;
+ TValue ground_env = G(K)->ground_env;
TValue symbol, value;
/* 8.1.1 make-encapsulation-type */
diff --git a/src/kgenv_mut.c b/src/kgenv_mut.c
@@ -212,7 +212,7 @@ void do_import(klisp_State *K)
kmake_continuation(K, kget_cc(K), do_match, 3,
symbols, denv, sname);
kset_cc(K, new_cont);
- ktail_eval(K, kcons(K, K->list_app, symbols), env);
+ ktail_eval(K, kcons(K, G(K)->list_app, symbols), env);
}
}
@@ -319,7 +319,7 @@ void SimportB(klisp_State *K)
/* init ground */
void kinit_env_mut_ground_env(klisp_State *K)
{
- TValue ground_env = K->ground_env;
+ TValue ground_env = G(K)->ground_env;
TValue symbol, value;
/* 4.9.1 $define! */
@@ -332,10 +332,11 @@ void kinit_env_mut_ground_env(klisp_State *K)
add_operative(K, ground_env, "$import!", SimportB, 1, symbol);
}
+/* XXX lock? */
/* init continuation names */
void kinit_env_mut_cont_names(klisp_State *K)
{
- Table *t = tv2table(K->cont_name_table);
+ Table *t = tv2table(G(K)->cont_name_table);
add_cont_name(K, t, do_match, "match-ptree");
add_cont_name(K, t, do_set_eval_obj, "set-eval-obj");
diff --git a/src/kgenvironments.c b/src/kgenvironments.c
@@ -259,7 +259,7 @@ void Slet(klisp_State *K)
bptree, KNIL, KNIL, new_env, b2tv(false), body);
kset_cc(K, new_cont);
- TValue expr = kcons(K, K->list_app, exprs);
+ TValue expr = kcons(K, G(K)->list_app, exprs);
krooted_tvs_pop(K);
krooted_tvs_pop(K);
@@ -349,8 +349,8 @@ void make_kernel_standard_environment(klisp_State *K)
check_0p(K, ptree);
/* std environments have hashtable for bindings */
- TValue new_env = kmake_table_environment(K, K->ground_env);
-// TValue new_env = kmake_environment(K, K->ground_env);
+ TValue new_env = kmake_table_environment(K, G(K)->ground_env);
+// TValue new_env = kmake_environment(K, G(K)->ground_env);
kapply_cc(K, new_env);
}
@@ -385,7 +385,7 @@ void SletS(klisp_State *K)
bptree, KNIL, KNIL, new_env, b2tv(false), body);
kset_cc(K, new_cont);
- TValue expr = kcons(K, K->list_app, exprs);
+ TValue expr = kcons(K, G(K)->list_app, exprs);
krooted_tvs_pop(K);
krooted_tvs_pop(K);
krooted_tvs_pop(K);
@@ -436,7 +436,7 @@ void Sletrec(klisp_State *K)
bptree, KNIL, KNIL, new_env, b2tv(true), body);
kset_cc(K, new_cont);
- TValue expr = kcons(K, K->list_app, exprs);
+ TValue expr = kcons(K, G(K)->list_app, exprs);
krooted_tvs_pop(K);
krooted_tvs_pop(K);
@@ -477,7 +477,7 @@ void SletrecS(klisp_State *K)
bptree, KNIL, KNIL, new_env, b2tv(true), body);
kset_cc(K, new_cont);
- TValue expr = kcons(K, K->list_app, exprs);
+ TValue expr = kcons(K, G(K)->list_app, exprs);
krooted_tvs_pop(K);
krooted_tvs_pop(K);
@@ -555,7 +555,7 @@ void Slet_redirect(klisp_State *K)
body = copy_es_immutable_h(K, body, false);
krooted_tvs_push(K, body);
- TValue eexpr = kcons(K, K->list_app, exprs);
+ TValue eexpr = kcons(K, G(K)->list_app, exprs);
krooted_tvs_push(K, eexpr);
TValue new_cont =
@@ -597,14 +597,14 @@ void Slet_safe(klisp_State *K)
/* according to the definition of the report it should be a child
of a child of the ground environment, but since this is a fresh
environment, the semantics are the same */
- TValue new_env = kmake_environment(K, K->ground_env);
+ TValue new_env = kmake_environment(K, G(K)->ground_env);
krooted_tvs_push(K, new_env);
TValue new_cont =
kmake_continuation(K, kget_cc(K), do_let, 7, sname,
bptree, KNIL, KNIL, new_env, b2tv(false), body);
kset_cc(K, new_cont);
- TValue expr = kcons(K, K->list_app, exprs);
+ TValue expr = kcons(K, G(K)->list_app, exprs);
krooted_tvs_pop(K);
krooted_tvs_pop(K);
krooted_tvs_pop(K);
@@ -684,7 +684,7 @@ void Sbindings_to_environment(klisp_State *K)
TValue new_cont = kmake_continuation(K, kget_cc(K),
do_b_to_env, 2, bptree, new_env);
kset_cc(K, new_cont);
- TValue expr = kcons(K, K->list_app, exprs);
+ TValue expr = kcons(K, G(K)->list_app, exprs);
krooted_tvs_pop(K);
krooted_tvs_pop(K);
@@ -746,7 +746,7 @@ void eval_string(klisp_State *K)
/* init ground */
void kinit_environments_ground_env(klisp_State *K)
{
- TValue ground_env = K->ground_env;
+ TValue ground_env = G(K)->ground_env;
TValue symbol, value;
/* 4.8.1 environment? */
@@ -788,10 +788,11 @@ void kinit_environments_ground_env(klisp_State *K)
add_applicative(K, ground_env, "eval-string", eval_string, 0);
}
+/* XXX lock? */
/* init continuation names */
void kinit_environments_cont_names(klisp_State *K)
{
- Table *t = tv2table(K->cont_name_table);
+ Table *t = tv2table(G(K)->cont_name_table);
add_cont_name(K, t, do_let, "eval-let");
add_cont_name(K, t, do_let_redirect, "eval-let-redirect");
diff --git a/src/kgeqp.c b/src/kgeqp.c
@@ -57,7 +57,7 @@ void eqp(klisp_State *K)
/* init ground */
void kinit_eqp_ground_env(klisp_State *K)
{
- TValue ground_env = K->ground_env;
+ TValue ground_env = G(K)->ground_env;
TValue symbol, value;
/* 4.2.1 eq? */
/* 6.5.1 eq? */
diff --git a/src/kgequalp.c b/src/kgequalp.c
@@ -69,7 +69,7 @@ void equalp(klisp_State *K)
/* init ground */
void kinit_equalp_ground_env(klisp_State *K)
{
- TValue ground_env = K->ground_env;
+ TValue ground_env = G(K)->ground_env;
TValue symbol, value;
/* 4.3.1 equal? */
/* 6.6.1 equal? */
diff --git a/src/kgerrors.c b/src/kgerrors.c
@@ -44,7 +44,7 @@ void kgraise(klisp_State *K)
UNUSED(denv);
bind_1p(K, ptree, obj);
- kcall_cont(K, K->error_cont, obj);
+ kcall_cont(K, G(K)->error_cont, obj);
}
void error_object_message(klisp_State *K)
@@ -90,17 +90,17 @@ void do_exception_cont(klisp_State *K)
/* Create system-error-continuation. */
void kinit_error_hierarchy(klisp_State *K)
{
- klisp_assert(ttiscontinuation(K->error_cont));
- klisp_assert(ttisinert(K->system_error_cont));
+ klisp_assert(ttiscontinuation(G(K)->error_cont));
+ klisp_assert(ttisinert(G(K)->system_error_cont));
- K->system_error_cont = kmake_continuation(K, K->error_cont,
+ G(K)->system_error_cont = kmake_continuation(K, G(K)->error_cont,
do_exception_cont, 0);
}
/* init ground */
void kinit_error_ground_env(klisp_State *K)
{
- TValue ground_env = K->ground_env;
+ TValue ground_env = G(K)->ground_env;
TValue symbol, value;
add_applicative(K, ground_env, "error-object?", typep, 2, symbol,
@@ -122,6 +122,6 @@ void kinit_error_ground_env(klisp_State *K)
See Common Lisp and mit scheme for examples
*/
- klisp_assert(ttiscontinuation(K->system_error_cont));
- add_value(K, ground_env, "system-error-continuation", K->system_error_cont);
+ klisp_assert(ttiscontinuation(G(K)->system_error_cont));
+ add_value(K, ground_env, "system-error-continuation", G(K)->system_error_cont);
}
diff --git a/src/kgffi.c b/src/kgffi.c
@@ -689,7 +689,7 @@ static TValue ffi_callback_guard(ffi_callback_t *cb, klisp_CFunction fn)
{
TValue app = kmake_applicative(cb->K, fn, 1, p2tv(cb));
krooted_tvs_push(cb->K, app);
- TValue ls1 = kimm_list(cb->K, 2, cb->K->root_cont, app);
+ TValue ls1 = kimm_list(cb->K, 2, G(cb->K)->root_cont, app);
krooted_tvs_push(cb->K, ls1);
TValue ls2 = kimm_list(cb->K, 1, ls1);
krooted_tvs_pop(cb->K);
@@ -1153,7 +1153,7 @@ void ffi_klisp_state(klisp_State *K)
/* init ground */
void kinit_ffi_ground_env(klisp_State *K)
{
- TValue ground_env = K->ground_env;
+ TValue ground_env = G(K)->ground_env;
TValue symbol, value;
/* create encapsulation keys */
@@ -1183,10 +1183,11 @@ void kinit_ffi_ground_env(klisp_State *K)
add_applicative(K, ground_env, "ffi-call-interface?", enc_typep, 1, cif_key);
}
+/* XXX lock? */
/* init continuation names */
void kinit_ffi_cont_names(klisp_State *K)
{
- Table *t = tv2table(K->cont_name_table);
+ Table *t = tv2table(G(K)->cont_name_table);
add_cont_name(K, t, do_ffi_callback_encode_result,
"ffi-callback-encode-result");
diff --git a/src/kghelpers.c b/src/kghelpers.c
@@ -27,10 +27,11 @@
#include "kencapsulation.h"
#include "kpromise.h"
+/* XXX lock? */
/* Initialization of continuation names */
void kinit_kghelpers_cont_names(klisp_State *K)
{
- Table *t = tv2table(K->cont_name_table);
+ Table *t = tv2table(G(K)->cont_name_table);
add_cont_name(K, t, do_seq, "eval-sequence");
add_cont_name(K, t, do_pass_value, "pass-value");
add_cont_name(K, t, do_return_value, "return-value");
@@ -589,7 +590,7 @@ TValue list_to_string_h(klisp_State *K, TValue ls, int32_t length)
TValue new_str;
/* the if isn't strictly necessary but it's clearer this way */
if (length == 0) {
- return K->empty_string;
+ return G(K)->empty_string;
} else {
new_str = kstring_new_s(K, length);
char *buf = kstring_buf(new_str);
@@ -611,7 +612,7 @@ TValue list_to_vector_h(klisp_State *K, TValue ls, int32_t length)
{
if (length == 0) {
- return K->empty_vector;
+ return G(K)->empty_vector;
} else {
TValue new_vec = kvector_new_sf(K, length, KINERT);
TValue *buf = kvector_buf(new_vec);
@@ -628,7 +629,7 @@ TValue list_to_bytevector_h(klisp_State *K, TValue ls, int32_t length)
TValue new_bb;
/* the if isn't strictly necessary but it's clearer this way */
if (length == 0) {
- return K->empty_bytevector;
+ return G(K)->empty_bytevector;
} else {
new_bb = kbytevector_new_s(K, length);
uint8_t *buf = kbytevector_buf(new_bb);
@@ -1775,7 +1776,7 @@ TValue make_bind_continuation(klisp_State *K, TValue key,
TValue exit_int = kmake_operative(K, do_set_pass,
3, key, old_flag, old_value);
krooted_tvs_push(K, exit_int);
- TValue exit_guard = kcons(K, K->root_cont, exit_int);
+ TValue exit_guard = kcons(K, G(K)->root_cont, exit_int);
krooted_tvs_pop(K); /* already rooted in guard */
krooted_tvs_push(K, exit_guard);
TValue exit_guards = kcons(K, exit_guard, KNIL);
@@ -1785,7 +1786,7 @@ TValue make_bind_continuation(klisp_State *K, TValue key,
TValue entry_int = kmake_operative(K, do_set_pass,
3, key, new_flag, new_value);
krooted_tvs_push(K, entry_int);
- TValue entry_guard = kcons(K, K->root_cont, entry_int);
+ TValue entry_guard = kcons(K, G(K)->root_cont, entry_int);
krooted_tvs_pop(K); /* already rooted in guard */
krooted_tvs_push(K, entry_guard);
TValue entry_guards = kcons(K, entry_guard, KNIL);
diff --git a/src/kgkd_vars.c b/src/kgkd_vars.c
@@ -59,7 +59,7 @@ void make_keyed_dynamic_variable(klisp_State *K)
/* init ground */
void kinit_kgkd_vars_ground_env(klisp_State *K)
{
- TValue ground_env = K->ground_env;
+ TValue ground_env = G(K)->ground_env;
TValue symbol, value;
/* 10.1.1 make-keyed-dynamic-variable */
diff --git a/src/kgkeywords.c b/src/kgkeywords.c
@@ -83,7 +83,7 @@ void symbol_to_keyword(klisp_State *K)
/* init ground */
void kinit_keywords_ground_env(klisp_State *K)
{
- TValue ground_env = K->ground_env;
+ TValue ground_env = G(K)->ground_env;
TValue symbol, value;
/*
diff --git a/src/kgks_vars.c b/src/kgks_vars.c
@@ -90,7 +90,7 @@ void make_keyed_static_variable(klisp_State *K)
/* init ground */
void kinit_kgks_vars_ground_env(klisp_State *K)
{
- TValue ground_env = K->ground_env;
+ TValue ground_env = G(K)->ground_env;
TValue symbol, value;
/* 11.1.1 make-keyed-static-variable */
diff --git a/src/kglibraries.c b/src/kglibraries.c
@@ -127,7 +127,7 @@ static TValue libraries_registry_assoc(klisp_State *K, TValue name, TValue *last
{
TValue last = KNIL;
TValue res = KNIL;
- for (TValue ls = K->libraries_registry; !ttisnil(ls); last = ls,
+ for (TValue ls = G(K)->libraries_registry; !ttisnil(ls); last = ls,
ls = kcdr(ls)) {
if (equal2p(K, kcar(kcar(ls)), name)) {
res = kcar(ls);
@@ -180,8 +180,8 @@ static void do_register_library(klisp_State *K)
}
TValue np = kcons(K, name, obj);
krooted_tvs_push(K, np);
- np = kcons(K, np, K->libraries_registry);
- K->libraries_registry = np;
+ np = kcons(K, np, G(K)->libraries_registry);
+ G(K)->libraries_registry = np;
krooted_tvs_pop(K);
kapply_cc(K, KINERT);
}
@@ -215,7 +215,7 @@ static void Sunregister_libraryB(klisp_State *K)
return;
}
if (ttisnil(last)) { /* it's in the first pair */
- K->libraries_registry = kcdr(K->libraries_registry);
+ G(K)->libraries_registry = kcdr(G(K)->libraries_registry);
} else {
kset_cdr(last, kcdr(kcdr(last)));
}
@@ -331,8 +331,8 @@ static void do_provide_library(klisp_State *K)
TValue np = kcons(K, name, library);
krooted_tvs_pop(K); /* library */
krooted_tvs_push(K, np);
- np = kcons(K, np, K->libraries_registry);
- K->libraries_registry = np;
+ np = kcons(K, np, G(K)->libraries_registry);
+ G(K)->libraries_registry = np;
krooted_tvs_pop(K);
kapply_cc(K, KINERT);
}
@@ -728,7 +728,7 @@ static void Simport_libraryB(klisp_State *K)
/* init ground */
void kinit_libraries_ground_env(klisp_State *K)
{
- TValue ground_env = K->ground_env;
+ TValue ground_env = G(K)->ground_env;
TValue symbol, value;
add_applicative(K, ground_env, "library?", typep, 2, symbol,
@@ -752,10 +752,11 @@ void kinit_libraries_ground_env(klisp_State *K)
add_operative(K, ground_env, "$import-library!", Simport_libraryB, 0);
}
+/* XXX lock? */
/* init continuation names */
void kinit_libraries_cont_names(klisp_State *K)
{
- Table *t = tv2table(K->cont_name_table);
+ Table *t = tv2table(G(K)->cont_name_table);
add_cont_name(K, t, do_register_library, "register-library");
add_cont_name(K, t, do_provide_library, "provide-library");
diff --git a/src/kgnumbers.c b/src/kgnumbers.c
@@ -1662,7 +1662,7 @@ void kwith_strict_arithmetic(klisp_State *K)
bind_2tp(K, ptree, "bool", ttisboolean, strictp,
"combiner", ttiscombiner, comb);
- TValue op = kmake_operative(K, do_bind, 1, K->kd_strict_arith_key);
+ TValue op = kmake_operative(K, do_bind, 1, G(K)->kd_strict_arith_key);
krooted_tvs_push(K, op);
TValue args = klist(K, 2, strictp, comb);
@@ -2288,7 +2288,7 @@ void number_to_string(klisp_State *K)
radix = ivalue(maybe_radix);
char small_buf[64]; /* for fixints */
- TValue buf_str = K->empty_string; /* for bigrats, bigints and doubles */
+ TValue buf_str = G(K)->empty_string; /* for bigrats, bigints and doubles */
krooted_vars_push(K, &buf_str);
char *buf;
@@ -2500,7 +2500,7 @@ void string_to_number(klisp_State *K)
/* init ground */
void kinit_numbers_ground_env(klisp_State *K)
{
- TValue ground_env = K->ground_env;
+ TValue ground_env = G(K)->ground_env;
TValue symbol, value;
/* No complex or bounded reals for now */
diff --git a/src/kgpair_mut.c b/src/kgpair_mut.c
@@ -488,7 +488,7 @@ void memqp(klisp_State *K)
/* init ground */
void kinit_pair_mut_ground_env(klisp_State *K)
{
- TValue ground_env = K->ground_env;
+ TValue ground_env = G(K)->ground_env;
TValue symbol, value;
/* 4.7.1 set-car!, set-cdr! */
diff --git a/src/kgpairs_lists.c b/src/kgpairs_lists.c
@@ -1215,7 +1215,7 @@ void reduce(klisp_State *K)
/* init ground */
void kinit_pairs_lists_ground_env(klisp_State *K)
{
- TValue ground_env = K->ground_env;
+ TValue ground_env = G(K)->ground_env;
TValue symbol, value;
/* 4.6.1 pair? */
@@ -1324,10 +1324,11 @@ void kinit_pairs_lists_ground_env(klisp_State *K)
add_applicative(K, ground_env, "reduce", reduce, 0);
}
+/* XXX lock? */
/* init continuation names */
void kinit_pairs_lists_cont_names(klisp_State *K)
{
- Table *t = tv2table(K->cont_name_table);
+ Table *t = tv2table(G(K)->cont_name_table);
add_cont_name(K, t, do_memberp, "member?-search");
add_cont_name(K, t, do_assoc, "assoc-search");
diff --git a/src/kgports.c b/src/kgports.c
@@ -285,7 +285,7 @@ void gread(klisp_State *K)
TValue port = ptree;
if (!get_opt_tpar(K, port, "port", ttisport)) {
- port = kcdr(K->kd_in_port_key); /* access directly */
+ port = kcdr(G(K)->kd_in_port_key); /* access directly */
}
if (!kport_is_input(port)) {
@@ -318,7 +318,7 @@ void gwrite(klisp_State *K)
port);
if (!get_opt_tpar(K, port, "port", ttisport)) {
- port = kcdr(K->kd_out_port_key); /* access directly */
+ port = kcdr(G(K)->kd_out_port_key); /* access directly */
}
if (!kport_is_output(port)) {
@@ -351,7 +351,7 @@ void gwrite_simple(klisp_State *K)
port);
if (!get_opt_tpar(K, port, "port", ttisport)) {
- port = kcdr(K->kd_out_port_key); /* access directly */
+ port = kcdr(G(K)->kd_out_port_key); /* access directly */
}
if (!kport_is_output(port)) {
@@ -384,7 +384,7 @@ void newline(klisp_State *K)
TValue port = ptree;
if (!get_opt_tpar(K, port, "port", ttisport)) {
- port = kcdr(K->kd_out_port_key); /* access directly */
+ port = kcdr(G(K)->kd_out_port_key); /* access directly */
}
if (!kport_is_output(port)) {
@@ -416,7 +416,7 @@ void write_char(klisp_State *K)
port);
if (!get_opt_tpar(K, port, "port", ttisport)) {
- port = kcdr(K->kd_out_port_key); /* access directly */
+ port = kcdr(G(K)->kd_out_port_key); /* access directly */
}
if (!kport_is_output(port)) {
@@ -450,7 +450,7 @@ void read_peek_char(klisp_State *K)
TValue port = ptree;
if (!get_opt_tpar(K, port, "port", ttisport)) {
- port = kcdr(K->kd_in_port_key); /* access directly */
+ port = kcdr(G(K)->kd_in_port_key); /* access directly */
}
if (!kport_is_input(port)) {
@@ -491,7 +491,7 @@ void char_readyp(klisp_State *K)
TValue port = ptree;
if (!get_opt_tpar(K, port, "port", ttisport)) {
- port = kcdr(K->kd_in_port_key); /* access directly */
+ port = kcdr(G(K)->kd_in_port_key); /* access directly */
}
if (!kport_is_input(port)) {
@@ -522,7 +522,7 @@ void write_u8(klisp_State *K)
bind_al1tp(K, ptree, "u8", ttisu8, u8, port);
if (!get_opt_tpar(K, port, "port", ttisport)) {
- port = kcdr(K->kd_out_port_key); /* access directly */
+ port = kcdr(G(K)->kd_out_port_key); /* access directly */
}
if (!kport_is_output(port)) {
@@ -556,7 +556,7 @@ void read_peek_u8(klisp_State *K)
TValue port = ptree;
if (!get_opt_tpar(K, port, "port", ttisport)) {
- port = kcdr(K->kd_in_port_key); /* access directly */
+ port = kcdr(G(K)->kd_in_port_key); /* access directly */
}
if (!kport_is_input(port)) {
@@ -597,7 +597,7 @@ void u8_readyp(klisp_State *K)
TValue port = ptree;
if (!get_opt_tpar(K, port, "port", ttisport)) {
- port = kcdr(K->kd_in_port_key); /* access directly */
+ port = kcdr(G(K)->kd_in_port_key); /* access directly */
}
if (!kport_is_input(port)) {
@@ -681,7 +681,7 @@ TValue make_guarded_read_cont(klisp_State *K, TValue parent, TValue port)
TValue exit_int = kmake_operative(K, do_int_close_file,
1, port);
krooted_tvs_push(K, exit_int);
- TValue exit_guard = kcons(K, K->error_cont, exit_int);
+ TValue exit_guard = kcons(K, G(K)->error_cont, exit_int);
krooted_tvs_pop(K); /* alread in guard */
krooted_tvs_push(K, exit_guard);
TValue exit_guards = kcons(K, exit_guard, KNIL);
@@ -833,7 +833,7 @@ static TValue find_file (klisp_State *K, TValue name, TValue pname) {
/* lua_getfield(L, LUA_ENVIRONINDEX, pname); */
klisp_assert(ttisstring(name) && !kstring_emptyp(name));
const char *path = kstring_buf(pname);
- TValue next = K->empty_string;
+ TValue next = G(K)->empty_string;
krooted_vars_push(K, &next);
TValue wild = kstring_new_b(K, KLISP_PATH_MARK);
krooted_tvs_push(K, wild);
@@ -849,9 +849,10 @@ static TValue find_file (klisp_State *K, TValue name, TValue pname) {
krooted_tvs_pop(K);
krooted_vars_pop(K);
- return K->empty_string; /* return empty_string */
+ return G(K)->empty_string; /* return empty_string */
}
+/* XXX lock? */
/* ?.? require */
/*
** require is like load except that:
@@ -883,7 +884,7 @@ void require(klisp_State *K)
TValue saved_name = kstring_immutablep(name)? name :
kstring_new_bs_imm(K, kstring_buf(name), kstring_size(name));
- const TValue *node = klispH_getstr(tv2table(K->require_table),
+ const TValue *node = klispH_getstr(tv2table(G(K)->require_table),
tv2str(saved_name));
if (!ttisfree(*node)) {
/* was required already, nothing to be done */
@@ -891,9 +892,9 @@ void require(klisp_State *K)
}
krooted_tvs_push(K, saved_name);
- TValue filename = K->empty_string;
+ TValue filename = G(K)->empty_string;
krooted_vars_push(K, &filename);
- filename = find_file(K, name, K->require_path);
+ filename = find_file(K, name, G(K)->require_path);
if (kstring_emptyp(filename)) {
klispE_throw_simple_with_irritants(K, "Not found", 1, name);
@@ -906,7 +907,7 @@ void require(klisp_State *K)
required recursively. A third option would be to record the
sate of the require in the table, so we could have: error, required,
requiring, etc */
- *(klispH_setstr(K, tv2table(K->require_table), tv2str(saved_name))) =
+ *(klispH_setstr(K, tv2table(G(K)->require_table), tv2str(saved_name))) =
KTRUE;
krooted_tvs_pop(K); /* saved_name no longer necessary */
@@ -941,7 +942,7 @@ void require(klisp_State *K)
} else {
TValue tail = kcdr(ls);
/* std environments have hashtable for bindings */
- TValue env = kmake_table_environment(K, K->ground_env);
+ TValue env = kmake_table_environment(K, G(K)->ground_env);
if (ttispair(tail)) {
krooted_tvs_push(K, ls);
krooted_tvs_push(K, env);
@@ -961,6 +962,7 @@ void require(klisp_State *K)
}
}
+/* XXX lock? */
/* ?.? registered-requirement? */
void registered_requirementP(klisp_State *K)
{
@@ -976,11 +978,12 @@ void registered_requirementP(klisp_State *K)
TValue saved_name = kstring_immutablep(name)? name :
kstring_new_bs_imm(K, kstring_buf(name), kstring_size(name));
- const TValue *node = klispH_getstr(tv2table(K->require_table),
+ const TValue *node = klispH_getstr(tv2table(G(K)->require_table),
tv2str(saved_name));
kapply_cc(K, ttisfree(*node)? KFALSE : KTRUE);
}
+/* XXX lock? */
void register_requirementB(klisp_State *K)
{
bind_1tp(K, K->next_value, "string", ttisstring, name);
@@ -991,7 +994,7 @@ void register_requirementB(klisp_State *K)
TValue saved_name = kstring_immutablep(name)? name :
kstring_new_bs_imm(K, kstring_buf(name), kstring_size(name));
- TValue *node = klispH_setstr(K, tv2table(K->require_table),
+ TValue *node = klispH_setstr(K, tv2table(G(K)->require_table),
tv2str(saved_name));
/* throw error if already registered */
@@ -1005,6 +1008,7 @@ void register_requirementB(klisp_State *K)
kapply_cc(K, KINERT);
}
+/* XXX lock? */
void unregister_requirementB(klisp_State *K)
{
bind_1tp(K, K->next_value, "string", ttisstring, name);
@@ -1015,7 +1019,7 @@ void unregister_requirementB(klisp_State *K)
TValue saved_name = kstring_immutablep(name)? name :
kstring_new_bs_imm(K, kstring_buf(name), kstring_size(name));
- TValue *node = klispH_setstr(K, tv2table(K->require_table),
+ TValue *node = klispH_setstr(K, tv2table(G(K)->require_table),
tv2str(saved_name));
/* throw error if not registered */
@@ -1028,6 +1032,7 @@ void unregister_requirementB(klisp_State *K)
kapply_cc(K, KINERT);
}
+/* XXX lock? */
/* will throw an error if not found */
void find_required_filename(klisp_State *K)
{
@@ -1036,7 +1041,7 @@ void find_required_filename(klisp_State *K)
klispE_throw_simple(K, "Empty name");
return;
}
- TValue filename = find_file(K, name, K->require_path);
+ TValue filename = find_file(K, name, G(K)->require_path);
if (kstring_emptyp(filename)) {
klispE_throw_simple_with_irritants(K, "Not found", 1, name);
@@ -1061,12 +1066,12 @@ void get_module(klisp_State *K)
krooted_tvs_push(K, port);
/* std environments have hashtable for bindings */
- TValue env = kmake_table_environment(K, K->ground_env);
-// TValue env = kmake_environment(K, K->ground_env);
+ TValue env = kmake_table_environment(K, G(K)->ground_env);
+// TValue env = kmake_environment(K, G(K)->ground_env);
krooted_tvs_push(K, env);
if (get_opt_tpar(K, maybe_env, "environment", ttisenvironment)) {
- kadd_binding(K, env, K->module_params_sym, maybe_env);
+ kadd_binding(K, env, G(K)->module_params_sym, maybe_env);
}
TValue ret_env_cont = kmake_continuation(K, kget_cc(K), do_return_value,
@@ -1125,7 +1130,7 @@ void display(klisp_State *K)
port);
if (!get_opt_tpar(K, port, "port", ttisport)) {
- port = kcdr(K->kd_out_port_key); /* access directly */
+ port = kcdr(G(K)->kd_out_port_key); /* access directly */
}
if (!kport_is_output(port)) {
@@ -1156,7 +1161,7 @@ void read_line(klisp_State *K)
TValue port = ptree;
if (!get_opt_tpar(K, port, "port", ttisport)) {
- port = kcdr(K->kd_in_port_key); /* access directly */
+ port = kcdr(G(K)->kd_in_port_key); /* access directly */
}
if (!kport_is_input(port)) {
@@ -1187,7 +1192,7 @@ void flush(klisp_State *K)
TValue port = ptree;
if (!get_opt_tpar(K, port, "port", ttisport)) {
- port = kcdr(K->kd_out_port_key); /* access directly */
+ port = kcdr(G(K)->kd_out_port_key); /* access directly */
}
if (!kport_is_output(port)) {
@@ -1211,7 +1216,7 @@ void kinit_ports_ground_env(klisp_State *K)
** Some of these are from r7rs scheme
*/
- TValue ground_env = K->ground_env;
+ TValue ground_env = G(K)->ground_env;
TValue symbol, value;
/* 15.1.1 port? */
@@ -1241,19 +1246,19 @@ void kinit_ports_ground_env(klisp_State *K)
/* 15.1.3 with-input-from-file, with-ouput-to-file */
/* 15.1.? with-error-to-file */
add_applicative(K, ground_env, "with-input-from-file", with_file,
- 3, symbol, b2tv(false), K->kd_in_port_key);
+ 3, symbol, b2tv(false), G(K)->kd_in_port_key);
add_applicative(K, ground_env, "with-output-to-file", with_file,
- 3, symbol, b2tv(true), K->kd_out_port_key);
+ 3, symbol, b2tv(true), G(K)->kd_out_port_key);
add_applicative(K, ground_env, "with-error-to-file", with_file,
- 3, symbol, b2tv(true), K->kd_error_port_key);
+ 3, symbol, b2tv(true), G(K)->kd_error_port_key);
/* 15.1.4 get-current-input-port, get-current-output-port */
/* 15.1.? get-current-error-port */
add_applicative(K, ground_env, "get-current-input-port", get_current_port,
- 2, symbol, K->kd_in_port_key);
+ 2, symbol, G(K)->kd_in_port_key);
add_applicative(K, ground_env, "get-current-output-port", get_current_port,
- 2, symbol, K->kd_out_port_key);
+ 2, symbol, G(K)->kd_out_port_key);
add_applicative(K, ground_env, "get-current-error-port", get_current_port,
- 2, symbol, K->kd_error_port_key);
+ 2, symbol, G(K)->kd_error_port_key);
/* 15.1.5 open-input-file, open-output-file */
add_applicative(K, ground_env, "open-input-file", open_file, 2,
b2tv(false), b2tv(false));
@@ -1378,10 +1383,11 @@ void kinit_ports_ground_env(klisp_State *K)
*/
}
+/* XXX lock? */
/* init continuation names */
void kinit_ports_cont_names(klisp_State *K)
{
- Table *t = tv2table(K->cont_name_table);
+ Table *t = tv2table(G(K)->cont_name_table);
add_cont_name(K, t, do_close_file_ret, "close-file-and-ret");
}
diff --git a/src/kgpromises.c b/src/kgpromises.c
@@ -124,7 +124,7 @@ void Sdelay(klisp_State *K)
bind_1p(K, ptree, exp);
TValue promise_body = kcons(K, exp, KNIL);
krooted_vars_push(K, &promise_body);
- promise_body = kcons(K, K->memoize_app, promise_body);
+ promise_body = kcons(K, G(K)->memoize_app, promise_body);
TValue new_prom = kmake_promise(K, promise_body, denv);
krooted_vars_pop(K);
kapply_cc(K, new_prom);
@@ -133,7 +133,7 @@ void Sdelay(klisp_State *K)
/* init ground */
void kinit_promises_ground_env(klisp_State *K)
{
- TValue ground_env = K->ground_env;
+ TValue ground_env = G(K)->ground_env;
TValue symbol, value;
/* 9.1.1 promise? */
@@ -149,10 +149,11 @@ void kinit_promises_ground_env(klisp_State *K)
add_applicative(K, ground_env, "$delay", Sdelay, 0);
}
+/* XXX lock? */
/* init continuation names */
void kinit_promises_cont_names(klisp_State *K)
{
- Table *t = tv2table(K->cont_name_table);
+ Table *t = tv2table(G(K)->cont_name_table);
add_cont_name(K, t, do_handle_result, "promise-handle-result");
}
diff --git a/src/kground.c b/src/kground.c
@@ -53,6 +53,7 @@
#include "keval.h"
#include "krepl.h"
+/* XXX lock? */
/*
** This is called once to save the names of the types of continuations
** used in the ground environment & repl
@@ -61,7 +62,7 @@
void kinit_cont_names(klisp_State *K)
{
/* TEMP root and error continuations are set here (they are in kstate) */
- Table *t = tv2table(K->cont_name_table);
+ Table *t = tv2table(G(K)->cont_name_table);
add_cont_name(K, t, do_root_exit, "exit");
add_cont_name(K, t, do_error_exit, "error");
/* TEMP this is also in kstate */
diff --git a/src/kgstrings.c b/src/kgstrings.c
@@ -334,7 +334,7 @@ void substring(klisp_State *K)
TValue new_str;
/* the if isn't strictly necessary but it's clearer this way */
if (size == 0) {
- new_str = K->empty_string;
+ new_str = G(K)->empty_string;
} else {
/* always returns mutable strings */
new_str = kstring_new_bs(K, kstring_buf(str)+start, size);
@@ -374,7 +374,7 @@ void string_append(klisp_State *K)
int32_t size = (int32_t) total_size;
if (size == 0) {
- new_str = K->empty_string;
+ new_str = G(K)->empty_string;
} else {
new_str = kstring_new_s(K, size);
char *buf = kstring_buf(new_str);
@@ -442,7 +442,7 @@ void string_to_vector(klisp_State *K)
TValue res;
if (kstring_emptyp(str)) {
- res = K->empty_vector;
+ res = G(K)->empty_vector;
} else {
uint32_t size = kstring_size(str);
@@ -473,7 +473,7 @@ void vector_to_string(klisp_State *K)
TValue res;
if (kvector_emptyp(vec)) {
- res = K->empty_string;
+ res = G(K)->empty_string;
} else {
uint32_t size = kvector_size(vec);
@@ -507,7 +507,7 @@ void string_to_bytevector(klisp_State *K)
TValue res;
if (kstring_emptyp(str)) {
- res = K->empty_bytevector;
+ res = G(K)->empty_bytevector;
} else {
uint32_t size = kstring_size(str);
@@ -538,7 +538,7 @@ void bytevector_to_string(klisp_State *K)
TValue res;
if (kbytevector_emptyp(bb)) {
- res = K->empty_string;
+ res = G(K)->empty_string;
} else {
uint32_t size = kbytevector_size(bb);
res = kstring_new_s(K, size); /* no need to root this */
@@ -571,7 +571,7 @@ void string_copy(klisp_State *K)
TValue new_str;
/* the if isn't strictly necessary but it's clearer this way */
- if (tv_equal(str, K->empty_string)) {
+ if (tv_equal(str, G(K)->empty_string)) {
new_str = str;
} else {
new_str = kstring_new_bs(K, kstring_buf(str), kstring_size(str));
@@ -623,7 +623,7 @@ void string_fillB(klisp_State *K)
/* init ground */
void kinit_strings_ground_env(klisp_State *K)
{
- TValue ground_env = K->ground_env;
+ TValue ground_env = G(K)->ground_env;
TValue symbol, value;
/*
diff --git a/src/kgsymbols.c b/src/kgsymbols.c
@@ -59,7 +59,7 @@ void string_to_symbol(klisp_State *K)
/* init ground */
void kinit_symbols_ground_env(klisp_State *K)
{
- TValue ground_env = K->ground_env;
+ TValue ground_env = G(K)->ground_env;
TValue symbol, value;
/* 4.4.1 symbol? */
diff --git a/src/kgsystem.c b/src/kgsystem.c
@@ -254,7 +254,7 @@ TValue create_env_var_list(klisp_State *K)
/* init ground */
void kinit_system_ground_env(klisp_State *K)
{
- TValue ground_env = K->ground_env;
+ TValue ground_env = G(K)->ground_env;
TValue symbol, value;
/* ??.?.? get-current-second */
diff --git a/src/kgtables.c b/src/kgtables.c
@@ -311,7 +311,7 @@ static void hash_table_to_list(klisp_State *K)
/* init ground */
void kinit_tables_ground_env(klisp_State *K)
{
- TValue ground_env = K->ground_env;
+ TValue ground_env = G(K)->ground_env;
TValue symbol, value;
add_applicative(K, ground_env, "hash-table?", typep, 2, symbol,
diff --git a/src/kgvectors.c b/src/kgvectors.c
@@ -48,7 +48,7 @@ void make_vector(klisp_State *K)
return;
}
TValue new_vector = (ivalue(tv_s) == 0)?
- K->empty_vector
+ G(K)->empty_vector
: kvector_new_sf(K, ivalue(tv_s), fill);
kapply_cc(K, new_vector);
}
@@ -185,7 +185,7 @@ void bytevector_to_vector(klisp_State *K)
TValue res;
if (kbytevector_emptyp(str)) {
- res = K->empty_vector;
+ res = G(K)->empty_vector;
} else {
uint32_t size = kbytevector_size(str);
@@ -216,7 +216,7 @@ void vector_to_bytevector(klisp_State *K)
TValue res;
if (kvector_emptyp(vec)) {
- res = K->empty_bytevector;
+ res = G(K)->empty_bytevector;
} else {
uint32_t size = kvector_size(vec);
@@ -257,7 +257,7 @@ void vector_copyB(klisp_State *K)
}
if (!tv_equal(vector1, vector2) &&
- !tv_equal(vector1, K->empty_vector)) {
+ !tv_equal(vector1, G(K)->empty_vector)) {
memcpy(kvector_buf(vector2),
kvector_buf(vector1),
kvector_size(vector1) * sizeof(TValue));
@@ -306,7 +306,7 @@ void vector_copy_partial(klisp_State *K)
TValue new_vector;
/* the if isn't strictly necessary but it's clearer this way */
if (size == 0) {
- new_vector = K->empty_vector;
+ new_vector = G(K)->empty_vector;
} else {
new_vector = kvector_new_bs_g(K, true, kvector_buf(vector)
+ start, size);
@@ -428,7 +428,7 @@ void vector_to_immutable_vector(klisp_State *K)
/* init ground */
void kinit_vectors_ground_env(klisp_State *K)
{
- TValue ground_env = K->ground_env;
+ TValue ground_env = G(K)->ground_env;
TValue symbol, value;
/*
diff --git a/src/kkeyword.c b/src/kkeyword.c
@@ -14,6 +14,7 @@
/* for immutable table */
#include "kstring.h"
+/* XXX lock? */
/* No case folding is performed by these constructors */
TValue kkeyword_new_bs(klisp_State *K, const char *buf, int32_t size)
{
@@ -30,7 +31,7 @@ TValue kkeyword_new_bs(klisp_State *K, const char *buf, int32_t size)
otherwise keywords and their respective immutable string
would always fall in the same bucket */
/* look for it in the table */
- for (GCObject *o = K->strt.hash[lmod(h, K->strt.size)]; o != NULL;
+ for (GCObject *o = G(K)->strt.hash[lmod(h, G(K)->strt.size)]; o != NULL;
o = o->gch.next) {
klisp_assert(o->gch.tt == K_TKEYWORD || o->gch.tt == K_TSYMBOL ||
o->gch.tt == K_TSTRING || o->gch.tt == K_TBYTEVECTOR);
@@ -40,8 +41,8 @@ TValue kkeyword_new_bs(klisp_State *K, const char *buf, int32_t size)
String *ts = tv2str(((Keyword *) o)->str);
if (ts->size == size && (memcmp(buf, ts->b, size) == 0)) {
/* keyword and/or string may be dead */
- if (isdead(K, o)) changewhite(o);
- if (isdead(K, (GCObject *) ts)) changewhite((GCObject *) ts);
+ if (isdead(G(K), o)) changewhite(o);
+ if (isdead(G(K), (GCObject *) ts)) changewhite((GCObject *) ts);
return gc2keyw(o);
}
}
@@ -57,7 +58,7 @@ TValue kkeyword_new_bs(klisp_State *K, const char *buf, int32_t size)
/* header + gc_fields */
/* can't use klispC_link, because strings use the next pointer
differently */
- new_keyw->gct = klispC_white(K);
+ new_keyw->gct = klispC_white(G(K));
new_keyw->tt = K_TKEYWORD;
new_keyw->kflags = 0;
new_keyw->si = NULL;
@@ -68,7 +69,7 @@ TValue kkeyword_new_bs(klisp_State *K, const char *buf, int32_t size)
/* add to the string/keyword table (and link it) */
stringtable *tb;
- tb = &K->strt;
+ tb = &G(K)->strt;
h = lmod(h, tb->size);
new_keyw->next = tb->hash[h]; /* chain new entry */
tb->hash[h] = (GCObject *)(new_keyw);
diff --git a/src/klimits.h b/src/klimits.h
@@ -86,4 +86,13 @@
#define MINREADLINEBUFFER 80
#endif
+#ifndef klisp_lock
+#define klisp_lock(K) ((void) 0)
+#define klisp_unlock(K) ((void) 0)
+#endif
+
+#ifndef klispi_threadyield
+#define klispi_threadyield(K) {klisp_unlock(K); klisp_lock(K);}
+#endif
+
#endif
diff --git a/src/klisp.c b/src/klisp.c
@@ -84,7 +84,7 @@ static void k_message (const char *pname, const char *msg)
(like the repl) */
static void show_error(klisp_State *K, TValue obj) {
/* FOR NOW used only for irritant list */
- TValue port = kcdr(K->kd_error_port_key);
+ TValue port = kcdr(G(K)->kd_error_port_key);
klisp_assert(ttisfport(port) && kfport_file(port) == stderr);
/* TEMP: obj should be an error obj */
@@ -212,7 +212,7 @@ static int dostring (klisp_State *K, const char *s, const char *name)
TValue exit_int = kmake_operative(K, do_int_mark_error,
1, p2tv(&errorp));
krooted_tvs_push(K, exit_int);
- TValue exit_guard = kcons(K, K->error_cont, exit_int);
+ TValue exit_guard = kcons(K, G(K)->error_cont, exit_int);
krooted_tvs_pop(K); /* already in guard */
krooted_tvs_push(K, exit_guard);
TValue exit_guards = kcons(K, exit_guard, KNIL);
@@ -224,7 +224,7 @@ static int dostring (klisp_State *K, const char *s, const char *name)
/* this is needed for interception code */
TValue env = kmake_empty_environment(K);
krooted_tvs_push(K, env);
- TValue outer_cont = kmake_continuation(K, K->root_cont,
+ TValue outer_cont = kmake_continuation(K, G(K)->root_cont,
do_pass_value, 2, entry_guards, env);
kset_outer_cont(outer_cont);
krooted_tvs_push(K, outer_cont);
@@ -260,8 +260,8 @@ static int dostring (klisp_State *K, const char *s, const char *name)
/* TODO factor this out into a get_ground_binding(K, char *) */
TValue ev = ksymbol_new_b(K, "eval-string", KNIL);
krooted_vars_push(K, &ev);
- klisp_assert(kbinds(K, K->ground_env, ev));
- ev = kunwrap(kget_binding(K, K->ground_env, ev));
+ klisp_assert(kbinds(K, G(K)->ground_env, ev));
+ ev = kunwrap(kget_binding(K, G(K)->ground_env, ev));
krooted_vars_pop(K);
krooted_tvs_pop(K);
@@ -317,7 +317,7 @@ static int dofile(klisp_State *K, const char *name)
/* XXX better do this in a continuation */
if (name == NULL) {
- port = kcdr(K->kd_in_port_key);
+ port = kcdr(G(K)->kd_in_port_key);
} else {
FILE *file = fopen(name, "r");
if (file == NULL) {
@@ -345,7 +345,7 @@ static int dofile(klisp_State *K, const char *name)
TValue exit_int = kmake_operative(K, do_int_mark_error,
1, p2tv(&errorp));
krooted_tvs_push(K, exit_int);
- TValue exit_guard = kcons(K, K->error_cont, exit_int);
+ TValue exit_guard = kcons(K, G(K)->error_cont, exit_int);
krooted_tvs_pop(K); /* already in guard */
krooted_tvs_push(K, exit_guard);
TValue exit_guards = kcons(K, exit_guard, KNIL);
@@ -357,7 +357,7 @@ static int dofile(klisp_State *K, const char *name)
/* this is needed for interception code */
TValue env = kmake_empty_environment(K);
krooted_tvs_push(K, env);
- TValue outer_cont = kmake_continuation(K, K->root_cont,
+ TValue outer_cont = kmake_continuation(K, G(K)->root_cont,
do_pass_value, 2, entry_guards, env);
kset_outer_cont(outer_cont);
krooted_tvs_push(K, outer_cont);
@@ -428,7 +428,7 @@ static int dorfile(klisp_State *K, const char *name)
TValue exit_int = kmake_operative(K, do_int_mark_error,
1, p2tv(&errorp));
krooted_tvs_push(K, exit_int);
- TValue exit_guard = kcons(K, K->error_cont, exit_int);
+ TValue exit_guard = kcons(K, G(K)->error_cont, exit_int);
krooted_tvs_pop(K); /* already in guard */
krooted_tvs_push(K, exit_guard);
TValue exit_guards = kcons(K, exit_guard, KNIL);
@@ -440,7 +440,7 @@ static int dorfile(klisp_State *K, const char *name)
/* this is needed for interception code */
TValue env = kmake_empty_environment(K);
krooted_tvs_push(K, env);
- TValue outer_cont = kmake_continuation(K, K->root_cont,
+ TValue outer_cont = kmake_continuation(K, G(K)->root_cont,
do_pass_value, 2, entry_guards, env);
kset_outer_cont(outer_cont);
krooted_tvs_push(K, outer_cont);
@@ -474,8 +474,8 @@ static int dorfile(klisp_State *K, const char *name)
/* TODO factor this out into a get_ground_binding(K, char *) */
TValue req = ksymbol_new_b(K, "require", KNIL);
krooted_vars_push(K, &req);
- klisp_assert(kbinds(K, K->ground_env, req));
- req = kunwrap(kget_binding(K, K->ground_env, req));
+ klisp_assert(kbinds(K, G(K)->ground_env, req));
+ req = kunwrap(kget_binding(K, G(K)->ground_env, req));
krooted_tvs_pop(K);
krooted_vars_pop(K);
@@ -615,8 +615,8 @@ static void populate_argument_lists(klisp_State *K, char **argv, int argc,
}
/* Store the script argument list */
obj = ksymbol_new_b(K, "get-script-arguments", KNIL);
- klisp_assert(kbinds(K, K->ground_env, obj));
- obj = kunwrap(kget_binding(K, K->ground_env, obj));
+ klisp_assert(kbinds(K, G(K)->ground_env, obj));
+ obj = kunwrap(kget_binding(K, G(K)->ground_env, obj));
tv2op(obj)->extra[0] = tail;
while(argc > 0) {
@@ -626,8 +626,8 @@ static void populate_argument_lists(klisp_State *K, char **argv, int argc,
}
/* Store the interpreter argument list */
obj = ksymbol_new_b(K, "get-interpreter-arguments", KNIL);
- klisp_assert(kbinds(K, K->ground_env, obj));
- obj = kunwrap(kget_binding(K, K->ground_env, obj));
+ klisp_assert(kbinds(K, G(K)->ground_env, obj));
+ obj = kunwrap(kget_binding(K, G(K)->ground_env, obj));
tv2op(obj)->extra[0] = tail;
krooted_vars_pop(K);
diff --git a/src/kmem.c b/src/kmem.c
@@ -70,24 +70,25 @@ void *klispM_toobig (klisp_State *K) {
/*
** generic allocation routine.
*/
+/* XXX lock? */
void *klispM_realloc_ (klisp_State *K, void *block, size_t osize, size_t nsize) {
klisp_assert((osize == 0) == (block == NULL));
/* TEMP: for now only Stop the world GC */
/* TEMP: prevent recursive call of klispC_fullgc() */
#ifdef KUSE_GC
- if (nsize > 0 && K->totalbytes - osize + nsize >= K->GCthreshold) {
+ if (nsize > 0 && G(K)->totalbytes - osize + nsize >= G(K)->GCthreshold) {
#ifdef KDEBUG_GC
- printf("GC START, total_bytes: %d\n", K->totalbytes);
+ printf("GC START, total_bytes: %d\n", G(K)->totalbytes);
#endif
klispC_fullgc(K);
#ifdef KDEBUG_GC
- printf("GC END, total_bytes: %d\n", K->totalbytes);
+ printf("GC END, total_bytes: %d\n", G(K)->totalbytes);
#endif
}
#endif
- block = (*K->frealloc)(K->ud, block, osize, nsize);
+ block = (*G(K)->frealloc)(G(K)->ud, block, osize, nsize);
if (block == NULL && nsize > 0) {
/* TEMP: try GC if there is no more mem */
@@ -96,6 +97,6 @@ void *klispM_realloc_ (klisp_State *K, void *block, size_t osize, size_t nsize)
abort();
}
klisp_assert((nsize == 0) == (block == NULL));
- K->totalbytes = (K->totalbytes - osize) + nsize;
+ G(K)->totalbytes = (G(K)->totalbytes - osize) + nsize;
return block;
}
diff --git a/src/kobject.h b/src/kobject.h
@@ -717,6 +717,7 @@ const TValue kfree;
#define gc2vector(o_) (gc2tv(K_TAG_VECTOR, o_))
#define gc2keyw(o_) (gc2tv(K_TAG_KEYWORD, o_))
#define gc2lib(o_) (gc2tv(K_TAG_LIBRARY, o_))
+#define gc2th(o_) (gc2tv(K_TAG_THREAD, o_))
#define gc2deadkey(o_) (gc2tv(K_TAG_DEADKEY, o_))
/* Macro to convert a TValue into a specific heap allocated object */
@@ -740,6 +741,7 @@ const TValue kfree;
#define tv2port(v_) ((Port *) gcvalue(v_))
#define tv2keyw(v_) ((Keyword *) gcvalue(v_))
#define tv2lib(v_) ((Library *) gcvalue(v_))
+#define tv2th(v_) ((klisp_State *) gcvalue(v_))
#define tv2gch(v_) ((GCheader *) gcvalue(v_))
#define tv2mgch(v_) ((MGCheader *) gcvalue(v_))
@@ -897,9 +899,9 @@ int32_t kmark_count;
#define checkconsistency(obj) \
klisp_assert(!iscollectable(obj) || (ttype_(obj) == gcvalue(obj)->gch.tt))
-#define checkliveness(k,obj) \
+#define checkliveness(g,obj) \
klisp_assert(!iscollectable(obj) || \
- ((ttype_(obj) == gcvalue(obj)->gch.tt) && !isdead(k, gcvalue(obj))))
+ ((ttype_(obj) == gcvalue(obj)->gch.tt) && !isdead(g, gcvalue(obj))))
#endif
diff --git a/src/kport.c b/src/kport.c
@@ -146,7 +146,7 @@ TValue kmake_mport(klisp_State *K, TValue buffer, bool writep, bool binaryp)
/* port specific fields */
TValue tv_port = gc2mport(new_port);
- kport_filename(tv_port) = K->empty_string; /* XXX for now no filename */
+ kport_filename(tv_port) = G(K)->empty_string; /* XXX for now no filename */
/* line is 1-based and col is 0-based */
kport_line(tv_port) = 1;
kport_col(tv_port) = 0;
diff --git a/src/krepl.c b/src/krepl.c
@@ -43,7 +43,7 @@ void do_repl_read(klisp_State *K)
/* show prompt */
fprintf(stdout, KLISP_PROMPT);
- TValue port = kcdr(K->kd_in_port_key);
+ TValue port = kcdr(G(K)->kd_in_port_key);
klisp_assert(kfport_file(port) == stdin);
/* Workaround to the problem of the dangling '\n' in repl
(from previous line) */
@@ -70,7 +70,7 @@ void do_repl_eval(klisp_State *K)
/* print a newline to allow the shell a fresh line */
printf("\n");
/* This is ok because there is no interception possible */
- kset_cc(K, K->root_cont);
+ kset_cc(K, G(K)->root_cont);
kapply_cc(K, KINERT);
} else {
/* save the source code info of the object in loop_cont
@@ -93,7 +93,7 @@ void create_loop(klisp_State *K, TValue denv)
TValue error_int = kmake_operative(K, do_repl_int_error, 1, denv);
krooted_tvs_pop(K); /* already in cont */
krooted_tvs_push(K, error_int);
- TValue exit_guard = kcons(K, K->error_cont, error_int);
+ TValue exit_guard = kcons(K, G(K)->error_cont, error_int);
krooted_tvs_pop(K); /* already in guard */
krooted_tvs_push(K, exit_guard);
TValue exit_guards = kcons(K, exit_guard, KNIL);
@@ -105,7 +105,7 @@ void create_loop(klisp_State *K, TValue denv)
/* this is needed for interception code */
TValue env = kmake_empty_environment(K);
krooted_tvs_push(K, env);
- TValue outer_cont = kmake_continuation(K, K->root_cont,
+ TValue outer_cont = kmake_continuation(K, G(K)->root_cont,
do_pass_value, 2, entry_guards, env);
kset_outer_cont(outer_cont);
krooted_tvs_push(K, outer_cont);
@@ -140,7 +140,7 @@ void do_repl_loop(klisp_State *K)
** xparams[0]: dynamic environment
*/
- TValue port = kcdr(K->kd_out_port_key);
+ TValue port = kcdr(G(K)->kd_out_port_key);
klisp_assert(kfport_file(port) == stdout);
/* false: quote strings, escape chars */
@@ -171,7 +171,7 @@ void do_repl_int_error(klisp_State *K)
TValue divert = kcadr(ptree);
/* FOR NOW used only for irritant list */
- TValue port = kcdr(K->kd_error_port_key);
+ TValue port = kcdr(G(K)->kd_error_port_key);
klisp_assert(ttisfport(port) && kfport_file(port) == stderr);
/* TEMP: obj should be an error obj */
@@ -254,7 +254,7 @@ void kinit_repl(klisp_State *K)
/* save the root cont in next_si to let the loop continuations have
source info, this is hackish but works */
- K->next_si = ktry_get_si(K, K->root_cont);
+ K->next_si = ktry_get_si(K, G(K)->root_cont);
#endif
/* GC: create_loop will root std_env */
@@ -264,7 +264,8 @@ void kinit_repl(klisp_State *K)
/* init continuation names */
void kinit_repl_cont_names(klisp_State *K)
{
- Table *t = tv2table(K->cont_name_table);
+/* XXX lock? */
+ Table *t = tv2table(G(K)->cont_name_table);
add_cont_name(K, t, do_repl_read, "repl-read");
add_cont_name(K, t, do_repl_eval, "repl-eval");
add_cont_name(K, t, do_repl_loop, "repl-print-loop");
diff --git a/src/kstate.c b/src/kstate.c
@@ -76,9 +76,9 @@ static void f_klispopen (klisp_State *K, void *ud) {
}
/* initialize temp stacks */
- K->ssize = KS_ISSIZE;
- K->stop = 0; /* stack is empty */
- K->sbuf = (TValue *)s;
+ ks_ssize(K) = KS_ISSIZE;
+ ks_stop(K) = 0; /* stack is empty */
+ ks_sbuf(K) = (TValue *)s;
ks_tbsize(K) = KS_ITBSIZE;
ks_tbidx(K) = 0; /* buffer is empty */
@@ -131,6 +131,15 @@ static void preinit_state (klisp_State *K, global_State *g) {
/* initialize writer */
K->write_displayp = false; /* set on each call to write */
+
+ /* put zeroes first, in case alloc fails */
+ ks_stop(K) = 0;
+ ks_ssize(K) = 0;
+ ks_sbuf(K) = NULL;
+
+ ks_tbidx(K) = 0;
+ ks_tbsize(K) = 0;
+ ks_tbuf(K) = NULL;
}
static void close_state(klisp_State *K)
@@ -393,6 +402,7 @@ klisp_State *klisp_newstate(klisp_Alloc f, void *ud)
/* set the threshold for gc start now that we have allocated all mem */
g->GCthreshold = 4*g->totalbytes;
+ /* luai_userstateopen(L); */
return K;
}
@@ -403,11 +413,35 @@ klisp_State *klisp_newthread(klisp_State *K)
return K;
}
-/* TODO */
-#if 0
-lua_State *luaE_newthread (lua_State *L) {
-void luaE_freethread (lua_State *L, lua_State *L1) {
-#endif
+/* XXX lock? */
+klisp_State *klispT_newthread(klisp_State *K)
+{
+ klisp_State *K1 = tostate(klispM_malloc(K, state_size(klisp_State)));
+ klispC_link(K, (GCObject *) K1, K_TTHREAD, 0);
+ preinit_state(K1, G(K));
+
+ /* initialize temp stacks */
+ ks_sbuf(K1) = (TValue *) klispM_malloc(K, KS_ISSIZE * sizeof(TValue));
+ ks_ssize(K1) = KS_ISSIZE;
+ ks_stop(K1) = 0; /* stack is empty */
+
+ ks_tbuf(K1) = (char *) klispM_malloc(K, KS_ITBSIZE);
+ ks_tbsize(K1) = KS_ITBSIZE;
+ ks_tbidx(K1) = 0; /* buffer is empty */
+
+ klisp_assert(iswhite((GCObject *) (K1)));
+ return K1;
+}
+
+
+/* XXX lock? */
+void klispT_freethread (klisp_State *K, klisp_State *K1)
+{
+ klispM_freemem(K, ks_sbuf(K1), ks_ssize(K1) * sizeof(TValue));
+ klispM_freemem(K, ks_tbuf(K1), ks_tbsize(K1));
+ /* userstatefree() */
+ klispM_freemem(K, fromstate(K1), state_size(klisp_State));
+}
void klisp_close (klisp_State *K)
{
@@ -428,6 +462,7 @@ void klisp_close (klisp_State *K)
luai_userstateclose(L);
#endif
+ /* luai_userstateclose(L); */
close_state(K);
}
diff --git a/src/kstate.h b/src/kstate.h
@@ -229,6 +229,9 @@ union GCObject {
#define KS_ISSIZE (1024)
#define KS_ITBSIZE (1024)
+klisp_State *klispT_newthread(klisp_State *K);
+void klispT_freethread(klisp_State *K, klisp_State *K1);
+
/*
** TEMP: for now use inlined functions, later check output in
** different compilers and/or profile to see if it's worthy to
@@ -512,7 +515,7 @@ static inline void klispS_tail_call_si(klisp_State *K, TValue top, TValue ptree,
#define ktail_eval(K_, p_, e_) \
{ klisp_State *K__ = (K_); \
TValue p__ = (p_); \
- klispS_tail_call_si(K__, K__->eval_op, p__, (e_), \
+ klispS_tail_call_si(K__, G(K__)->eval_op, p__, (e_), \
ktry_get_si(K__, p__)); \
return; }
diff --git a/src/kstring.c b/src/kstring.c
@@ -15,16 +15,17 @@
#include "kmem.h"
#include "kgc.h"
+/* XXX lock? */
/* for immutable string/symbols/bytevector table */
void klispS_resize (klisp_State *K, int32_t newsize)
{
GCObject **newhash;
stringtable *tb;
int32_t i;
- if (K->gcstate == GCSsweepstring)
+ if (G(K)->gcstate == GCSsweepstring)
return; /* cannot resize during GC traverse */
newhash = klispM_newvector(K, newsize, GCObject *);
- tb = &K->strt;
+ tb = &G(K)->strt;
for (i = 0; i < newsize; i++) newhash[i] = NULL;
/* rehash */
for (i = 0; i < tb->size; i++) {
@@ -76,6 +77,7 @@ TValue kstring_new_bs_g(klisp_State *K, bool m, const char *buf,
** Constructors for immutable strings
*/
+/* XXX lock? */
/* main constructor for immutable strings */
TValue kstring_new_bs_imm(klisp_State *K, const char *buf, uint32_t size)
{
@@ -87,7 +89,7 @@ TValue kstring_new_bs_imm(klisp_State *K, const char *buf, uint32_t size)
for (size1 = size; size1 >= step; size1 -= step) /* compute hash */
h = h ^ ((h<<5)+(h>>2)+ ((unsigned char) buf[size1-1]));
- for (GCObject *o = K->strt.hash[lmod(h, K->strt.size)];
+ for (GCObject *o = G(K)->strt.hash[lmod(h, G(K)->strt.size)];
o != NULL; o = o->gch.next) {
klisp_assert(o->gch.tt == K_TKEYWORD || o->gch.tt == K_TSYMBOL ||
o->gch.tt == K_TSTRING || o->gch.tt == K_TBYTEVECTOR);
@@ -97,7 +99,7 @@ TValue kstring_new_bs_imm(klisp_State *K, const char *buf, uint32_t size)
String *ts = (String *) o;
if (ts->size == size && (memcmp(buf, ts->b, size) == 0)) {
/* string may be dead */
- if (isdead(K, o)) changewhite(o);
+ if (isdead(G(K), o)) changewhite(o);
return gc2str(o);
}
}
@@ -114,7 +116,7 @@ TValue kstring_new_bs_imm(klisp_State *K, const char *buf, uint32_t size)
/* header + gc_fields */
/* can't use klispC_link, because strings use the next pointer
differently */
- new_str->gct = klispC_white(K);
+ new_str->gct = klispC_white(G(K));
new_str->tt = K_TSTRING;
new_str->kflags = K_FLAG_IMMUTABLE;
new_str->si = NULL;
@@ -129,7 +131,7 @@ TValue kstring_new_bs_imm(klisp_State *K, const char *buf, uint32_t size)
/* add to the string/symbol table (and link it) */
stringtable *tb;
- tb = &K->strt;
+ tb = &G(K)->strt;
h = lmod(h, tb->size);
new_str->next = tb->hash[h]; /* chain new entry */
tb->hash[h] = (GCObject *)(new_str);
@@ -161,8 +163,8 @@ TValue kstring_new_s(klisp_State *K, uint32_t size)
String *new_str;
if (size == 0) {
- klisp_assert(ttisstring(K->empty_string));
- return K->empty_string;
+ klisp_assert(ttisstring(G(K)->empty_string));
+ return G(K)->empty_string;
}
new_str = klispM_malloc(K, sizeof(String) + size + 1);
diff --git a/src/ksymbol.c b/src/ksymbol.c
@@ -19,6 +19,8 @@
/* No case folding is performed by these constructors */
+
+/* XXX lock? */
/*
** Interned symbols are only the ones that don't have source info
** (like those created with string->symbol)
@@ -38,7 +40,7 @@ TValue ksymbol_new_bs(klisp_State *K, const char *buf, int32_t size, TValue si)
would always fall in the same bucket */
/* look for it in the table only if it doesn't have source info */
if (ttisnil(si)) {
- for (GCObject *o = K->strt.hash[lmod(h, K->strt.size)];
+ for (GCObject *o = G(K)->strt.hash[lmod(h, G(K)->strt.size)];
o != NULL; o = o->gch.next) {
klisp_assert(o->gch.tt == K_TKEYWORD || o->gch.tt == K_TSYMBOL ||
o->gch.tt == K_TSTRING || o->gch.tt == K_TBYTEVECTOR);
@@ -48,8 +50,8 @@ TValue ksymbol_new_bs(klisp_State *K, const char *buf, int32_t size, TValue si)
String *ts = tv2str(((Symbol *) o)->str);
if (ts->size == size && (memcmp(buf, ts->b, size) == 0)) {
/* symbol and/or string may be dead */
- if (isdead(K, o)) changewhite(o);
- if (isdead(K, (GCObject *) ts)) changewhite((GCObject *) ts);
+ if (isdead(G(K), o)) changewhite(o);
+ if (isdead(G(K), (GCObject *) ts)) changewhite((GCObject *) ts);
return gc2sym(o);
}
}
@@ -67,7 +69,7 @@ TValue ksymbol_new_bs(klisp_State *K, const char *buf, int32_t size, TValue si)
/* header + gc_fields */
/* can't use klispC_link, because strings use the next pointer
differently */
- new_sym->gct = klispC_white(K);
+ new_sym->gct = klispC_white(G(K));
new_sym->tt = K_TSYMBOL;
new_sym->kflags = 0;
new_sym->si = NULL;
@@ -78,7 +80,7 @@ TValue ksymbol_new_bs(klisp_State *K, const char *buf, int32_t size, TValue si)
/* add to the string/symbol table (and link it) */
stringtable *tb;
- tb = &K->strt;
+ tb = &G(K)->strt;
h = lmod(h, tb->size);
new_sym->next = tb->hash[h]; /* chain new entry */
tb->hash[h] = (GCObject *)(new_sym);
diff --git a/src/ktable.c b/src/ktable.c
@@ -331,7 +331,7 @@ static void resize (klisp_State *K, Table *t, int32_t nasize, int32_t nhsize)
if (!ttisfree(t->array[i])) {
TValue v = t->array[i];
*klispH_setfixint(K, t, i) = v;
- checkliveness(K, v);
+ checkliveness(G(K), v);
}
}
/* shrink array */
@@ -343,7 +343,7 @@ static void resize (klisp_State *K, Table *t, int32_t nasize, int32_t nhsize)
if (!ttisfree(gval(old))) {
TValue v = gval(old);
*klispH_set(K, t, key2tval(old)) = v;
- checkliveness(K, v);
+ checkliveness(G(K), v);
}
}
if (nold != dummynode)
diff --git a/src/ktoken.c b/src/ktoken.c
@@ -354,10 +354,10 @@ TValue ktok_read_token(klisp_State *K)
continue;
case '(':
ktok_getc(K);
- return K->ktok_lparen;
+ return G(K)->ktok_lparen;
case ')':
ktok_getc(K);
- return K->ktok_rparen;
+ return G(K)->ktok_rparen;
case '"':
return ktok_read_string(K);
case '|':
@@ -382,7 +382,7 @@ TValue ktok_read_token(klisp_State *K)
continue;
case ';': /* sexp comment */
ktok_getc(K); /* discard the ';' */
- return K->ktok_sexp_comment;
+ return G(K)->ktok_sexp_comment;
case ':': /* keyword */
ktok_getc(K); /* discard the ':' */
chi = ktok_peekc(K);
@@ -1122,7 +1122,7 @@ TValue ktok_read_identifier_or_dot(klisp_State *K, bool keywordp)
return KINERT; /* avoid warning */
} else {
ks_tbclear(K);
- return K->ktok_dot;
+ return G(K)->ktok_dot;
}
}
diff --git a/src/kwrite.c b/src/kwrite.c
@@ -441,7 +441,9 @@ void kw_print_cont_type(klisp_State *K, TValue obj)
K->write_displayp = true; /* avoid "s and escapes */
Continuation *cont = tv2cont(obj);
- const TValue *node = klispH_get(tv2table(K->cont_name_table),
+
+ /* XXX lock? */
+ const TValue *node = klispH_get(tv2table(G(K)->cont_name_table),
p2tv(cont->fn));
char *type;
