From e0c6872cf40896c7be36b11dcc744620f10adf1d Mon Sep 17 00:00:00 2001
From: Norbert Preining <norbert@preining.info>
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

