summaryrefslogtreecommitdiff
path: root/macros/latex/contrib/lisp-on-tex/lisp-gc.sty
diff options
context:
space:
mode:
Diffstat (limited to 'macros/latex/contrib/lisp-on-tex/lisp-gc.sty')
-rw-r--r--macros/latex/contrib/lisp-on-tex/lisp-gc.sty197
1 files changed, 197 insertions, 0 deletions
diff --git a/macros/latex/contrib/lisp-on-tex/lisp-gc.sty b/macros/latex/contrib/lisp-on-tex/lisp-gc.sty
new file mode 100644
index 0000000000..672593c037
--- /dev/null
+++ b/macros/latex/contrib/lisp-on-tex/lisp-gc.sty
@@ -0,0 +1,197 @@
+\RequirePackage{xkeyval}
+
+\newcount\@lisp@gc@count
+\newcount\@lisp@gc@perform@result
+\def\@lisp@gc@alloc@count@max{32768} % memory limit
+\def\@lisp@gc@alloc@local{} % objects on stack
+\def\@lisp@gc@usedenv{} % used local environment
+\def\@lisp@gc@alloc@raw{} % used memory on local
+\def\@lisp@gc@alloc@pinning{} % pinned objects
+\def\@lisp@gc@mark@bitvector{} % mark bitmap
+\def\@lisp@gc@mark@bitvector@{} % mark bitmap (default)
+
+% execute GC option
+\DeclareOptionX{heapsize}{\def\@lisp@gc@alloc@count@max{#1}}
+\ProcessOptionsX
+
+% gc initializer (called by lisp-on-tex.sty)
+\def\@lisp@gc@init{%
+ \@lisp@gc@count=0\relax
+ \@lisp@gc@perform@result=\@lisp@gc@alloc@count@max\relax
+ % create mark bits
+ % clear all mark bits
+ \@tempcnta0
+ \@whilenum\@tempcnta<\@lisp@gc@alloc@count@max\do{%
+ \@lisp@gc@off@markbit{\the\@tempcnta}%
+ \advance\@tempcnta1}%
+ % set default value to each memory
+ \@tempcnta0
+ \@whilenum\@tempcnta<\@lisp@gc@alloc@count@max\do{%
+ \expandafter\gdef
+ \csname @lisp@gc@memory@\the\@tempcnta\endcsname
+ {\relax\relax}% initialize
+ \advance\@tempcnta1}}
+
+% allocator
+% The allocator define #1 to allocated the control sequence
+\def\@lisp@gc@alloc#1{%
+ % if memory is full, do gc
+ \ifnum\@lisp@gc@count<\@lisp@gc@alloc@count@max\else
+ \@lisp@gc@perform
+ \fi
+ % allocation
+ \def#1{}%
+ \@lisp@gc@alloc@@#1}
+\def\@lisp@gc@alloc@@#1{%
+ \csname if@lisp@gc@memory@\the\@lisp@gc@count\endcsname
+ \else % unused memory is found
+ % allocate
+ \expandafter\def\expandafter#1%
+ \expandafter{\csname @lisp@gc@memory@\the\@lisp@gc@count\endcsname}%
+ % clear memory (for marking)
+ \expandafter\gdef
+ \csname @lisp@gc@memory@\the\@lisp@gc@count\endcsname{\relax\relax}%
+ \fi
+ \global\advance\@lisp@gc@count1
+ \let\@@next\@gobble
+ \ifx#1\@empty
+ \ifnum\@lisp@gc@count<\@lisp@gc@alloc@count@max
+ \let\@@next\@lisp@gc@alloc@@
+ \else
+ \def\@@next{%
+ \@lisp@gc@perform
+ \ifnum\@lisp@gc@perform@result=0\relax
+ \expandafter\@gobble % empty
+ \else
+ \expandafter\@lisp@gc@alloc@@
+ \fi}%
+ \fi
+ \fi
+ \@@next#1}
+
+
+% GC main routine. The routine is called by the allocator.
+% If you want to call GC manually, you can do it.
+\def\@lisp@gc@perform{%
+ \message{LISP on TeX: now GCing...^^J}%
+ % reset result
+ \global\@lisp@gc@perform@result\@lisp@gc@alloc@count@max\relax
+ % clear all mark bits
+ \@tempcnta0
+ \@whilenum\@tempcnta<\@lisp@gc@count\do{%
+ \@lisp@gc@off@markbit{\the\@tempcnta}%
+ \advance\@tempcnta1}%
+ % start marking mode
+ \begingroup
+ % define all typelabels to mark mode
+ \@lisp@gc@make@tlabel@mark@mode
+ % init queue and enque root set
+ %% raw memory
+ \expandafter\def\expandafter\@lisp@gc@mark@Q\expandafter{\@lisp@gc@alloc@raw}%
+ %% local env
+ \expandafter\@lisp@gc@mark@env\@lisp@gc@usedenv\@lisp@unused\relax
+ %% global env
+ \expandafter\@lisp@gc@mark@env\@lisp@globalenv\@lisp@unused\relax
+ %% pinned objects
+ \@lisp@gc@alloc@pinning
+ %% stack
+ \@lisp@gc@alloc@local
+ % marking start
+ \@lisp@gc@foreachQ\@lisp@gc@mark@Q\@lisp@gc@mark
+ % end marking mode
+ \endgroup
+ % reset counter
+ \global\@lisp@gc@count0
+ % show GC result
+ \message{LISP on TeX: GC done (free \the\@lisp@gc@perform@result)^^J}}
+\def\@lisp@gc@make@tlabel@mark@mode{%
+ \@for\@lisp@on@tex@type:=\@defined@lisp@on@tex\do{%
+ \expandafter\let
+ \csname @tlabel@\@lisp@on@tex@type\endcsname\@gobble}%
+ \def\@tlabel@cons##1{\@lisp@gc@mark@cons##1}%
+ \def\@tlabel@mutable##1{\@lisp@gc@enQ\@lisp@gc@mark@Q{##1}}%
+ \def\@tlabel@closure##1{\@lisp@gc@mark@closure##1}%
+ \def\@tlabel@macro##1{\@lisp@gc@mark@closure##1}%
+ \def\@tlabel@exception##1{\@lisp@gc@mark@exception##1}%
+ \@for\@lisp@on@tex@type:=\@defined@additional@type\do{%
+ \expandafter\@lisp@gc@create@markmode@additional
+ \csname @tlabel@\@lisp@on@tex@type\endcsname
+ \csname @lisp@gc@trace\@lisp@on@tex@type\endcsname}}
+\def\@lisp@unused{\@lisp@unused@}
+\def\@lisp@gc@mark@cons#1#2{%
+ \@lisp@gc@enQ\@lisp@gc@mark@Q{#1}%
+ \@lisp@gc@enQ\@lisp@gc@mark@Q{#2}}
+\def\@lisp@gc@mark@closure#1#2#3#4{%
+ \@lisp@gc@mark@env#2\@lisp@unused\relax
+ #3{#4}}
+\def\@lisp@gc@mark@exception#1#2{#2}%
+\def\@lisp@gc@create@markmode@additional#1{%
+ \expandafter\@lisp@gc@create@markmode@additional@\expandafter#1}
+\def\@lisp@gc@create@markmode@additional@#1#2{\let#1#2}
+% mark objects in a environment
+\def\@lisp@gc@mark@env#1#2{%
+ \ifx#1\@lisp@unused
+ \let\@@next\relax
+ \else
+ \def\@@next{#2\@lisp@gc@mark@env}%
+ \fi
+ \@@next}
+% global let for save and restore memory
+\def\@lisp@gc@global@let#1{\expandafter\@lisp@gc@global@let@\expandafter#1}
+\def\@lisp@gc@global@let@#1#2{\global\let#1#2}
+% queue
+\def\@lisp@gc@enQ#1#2{% #1 : queue, #2 value
+ \expandafter\def\expandafter#1\expandafter{#1#2}}
+\def\@lisp@gc@deQ#1#2{% #1 : queue, #2 cs
+ \ifx#1\@empty
+ \def#2{}%
+ \else
+ \expandafter\@lisp@gc@deQ@\expandafter#1\expandafter#2#1\relax
+ \fi}
+\def\@lisp@gc@deQ@#1#2#3#4\relax{%
+ \def#1{#4}\def#2{#3}}
+\def\@lisp@gc@foreachQ#1#2{% #1 : queue, #2 : token -> 'a
+ \@lisp@gc@deQ#1\@lisp@gc@temp@local
+ \ifx\@lisp@gc@temp@local\@empty
+ \let\@@next\relax
+ \else
+ \def\@@next{%
+ \expandafter#2\expandafter{\@lisp@gc@temp@local}%
+ \@lisp@gc@foreachQ#1#2}%
+ \fi\@@next}
+% marker
+\def\@lisp@gc@mark#1{\expandafter\@lisp@gc@mark@\string#1\relax}
+\expandafter\def\expandafter\@lisp@gc@mark@\string\@lisp@gc@memory@#1\relax{%
+ \csname if@lisp@gc@memory@#1\endcsname\else
+ % count down remain memory
+ \global\advance\@lisp@gc@perform@result-1
+ % turn mark bit on
+ \@lisp@gc@on@markbit{#1}%
+ % enqueue if we need
+ \csname @lisp@gc@memory@#1\endcsname
+ \fi}
+
+
+% pin a object on global.
+\def\@lisp@gc@pinning#1#2{%
+ \expandafter\gdef\expandafter\@lisp@gc@alloc@pinning
+ \expandafter{\@lisp@gc@alloc@pinning#1{#2}}}
+
+% pinning objects on local.
+\def\@lisp@gc@save@objects@local#1{%
+ \expandafter\def\expandafter\@lisp@gc@alloc@local
+ \expandafter{\@lisp@gc@alloc@local#1}}
+
+% pinning memories on local.
+\def\@lisp@gc@save@memory@local#1{%
+ \expandafter\def\expandafter\@lisp@gc@alloc@raw
+ \expandafter{\@lisp@gc@alloc@raw#1}}
+
+% pinning environmnt on local.
+\def\@lisp@gc@save@env@local#1{%
+ \expandafter\def\expandafter\@lisp@gc@usedenv
+ \expandafter{\@lisp@gc@usedenv#1}}
+
+% for mark bits
+\def\@lisp@gc@on@markbit#1{\expandafter\global\expandafter\let\csname if@lisp@gc@memory@#1\endcsname\iftrue}
+\def\@lisp@gc@off@markbit#1{\expandafter\global\expandafter\let\csname if@lisp@gc@memory@#1\endcsname\iffalse} \ No newline at end of file