\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}