From e0c6872cf40896c7be36b11dcc744620f10adf1d Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Mon, 2 Sep 2019 13:46:59 +0900 Subject: Initial commit --- macros/latex/contrib/lisp-on-tex/lisp-gc.sty | 197 +++++++++++++++++++++++++++ 1 file changed, 197 insertions(+) create mode 100644 macros/latex/contrib/lisp-on-tex/lisp-gc.sty (limited to 'macros/latex/contrib/lisp-on-tex/lisp-gc.sty') 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 -- cgit v1.2.3