<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html>
<head>
<!-- Generated by HsColour, http://www.cs.york.ac.uk/fp/darcs/hscolour/ -->
<title>codeGen/CgStackery.lhs</title>
<link type='text/css' rel='stylesheet' href='hscolour.css' />
</head>
<body>
%
% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\section[CgStackery]{Stack management functions}
Stack-twiddling operations, which are pretty low-down and grimy.
(This is the module that knows all about stack layouts, etc.)
\begin{code}
<pre><a name="line-1"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>CgStackery</span> <span class='hs-layout'>(</span>
<a name="line-2"></a> <span class='hs-varid'>spRel</span><span class='hs-layout'>,</span> <span class='hs-varid'>getVirtSp</span><span class='hs-layout'>,</span> <span class='hs-varid'>getRealSp</span><span class='hs-layout'>,</span> <span class='hs-varid'>setRealSp</span><span class='hs-layout'>,</span>
<a name="line-3"></a> <span class='hs-varid'>setRealAndVirtualSp</span><span class='hs-layout'>,</span> <span class='hs-varid'>getSpRelOffset</span><span class='hs-layout'>,</span>
<a name="line-4"></a>
<a name="line-5"></a> <span class='hs-varid'>allocPrimStack</span><span class='hs-layout'>,</span> <span class='hs-varid'>allocStackTop</span><span class='hs-layout'>,</span> <span class='hs-varid'>deAllocStackTop</span><span class='hs-layout'>,</span>
<a name="line-6"></a> <span class='hs-varid'>adjustStackHW</span><span class='hs-layout'>,</span> <span class='hs-varid'>getFinalStackHW</span><span class='hs-layout'>,</span>
<a name="line-7"></a> <span class='hs-varid'>setStackFrame</span><span class='hs-layout'>,</span> <span class='hs-varid'>getStackFrame</span><span class='hs-layout'>,</span>
<a name="line-8"></a> <span class='hs-varid'>mkVirtStkOffsets</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkStkAmodes</span><span class='hs-layout'>,</span>
<a name="line-9"></a> <span class='hs-varid'>freeStackSlots</span><span class='hs-layout'>,</span>
<a name="line-10"></a> <span class='hs-varid'>pushUpdateFrame</span><span class='hs-layout'>,</span> <span class='hs-varid'>emitPushUpdateFrame</span><span class='hs-layout'>,</span>
<a name="line-11"></a> <span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-12"></a>
<a name="line-13"></a><span class='hs-cpp'>#include "HsVersions.h"</span>
<a name="line-14"></a>
<a name="line-15"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>CgMonad</span>
<a name="line-16"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>CgUtils</span>
<a name="line-17"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>CgProf</span>
<a name="line-18"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>SMRep</span>
<a name="line-19"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Cmm</span>
<a name="line-20"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>CmmUtils</span>
<a name="line-21"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>CLabel</span>
<a name="line-22"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Constants</span>
<a name="line-23"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Util</span>
<a name="line-24"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>OrdList</span>
<a name="line-25"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Outputable</span>
<a name="line-26"></a>
<a name="line-27"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection[CgUsages-stackery]{Monad things for fiddling with stack usage}
%* *
%************************************************************************
spRel is a little function that abstracts the stack direction. Note that most
of the code generator is dependent on the stack direction anyway, so
changing this on its own spells certain doom. ToDo: remove?
THIS IS DIRECTION SENSITIVE!
Stack grows down, positive virtual offsets correspond to negative
additions to the stack pointer.
\begin{code}
<pre><a name="line-1"></a><a name="spRel"></a><span class='hs-definition'>spRel</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>VirtualSpOffset</span> <span class='hs-comment'>-- virtual offset of Sp</span>
<a name="line-2"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>VirtualSpOffset</span> <span class='hs-comment'>-- virtual offset of The Thing</span>
<a name="line-3"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>WordOff</span> <span class='hs-comment'>-- integer offset</span>
<a name="line-4"></a><span class='hs-definition'>spRel</span> <span class='hs-varid'>sp</span> <span class='hs-varid'>off</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>sp</span> <span class='hs-comment'>-</span> <span class='hs-varid'>off</span>
</pre>\end{code}
@setRealAndVirtualSp@ sets into the environment the offsets of the
current position of the real and virtual stack pointers in the current
stack frame. The high-water mark is set too. It generates no code.
It is used to initialise things at the beginning of a closure body.
\begin{code}
<pre><a name="line-1"></a><a name="setRealAndVirtualSp"></a><span class='hs-definition'>setRealAndVirtualSp</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>VirtualSpOffset</span> <span class='hs-comment'>-- New real Sp</span>
<a name="line-2"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Code</span>
<a name="line-3"></a>
<a name="line-4"></a><span class='hs-definition'>setRealAndVirtualSp</span> <span class='hs-varid'>new_sp</span>
<a name="line-5"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>stk_usg</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getStkUsage</span>
<a name="line-6"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>setStkUsage</span> <span class='hs-layout'>(</span><span class='hs-varid'>stk_usg</span> <span class='hs-layout'>{</span><span class='hs-varid'>virtSp</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>new_sp</span><span class='hs-layout'>,</span>
<a name="line-7"></a> <span class='hs-varid'>realSp</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>new_sp</span><span class='hs-layout'>,</span>
<a name="line-8"></a> <span class='hs-varid'>hwSp</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>new_sp</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-9"></a>
<a name="line-10"></a><a name="getVirtSp"></a><span class='hs-definition'>getVirtSp</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>FCode</span> <span class='hs-conid'>VirtualSpOffset</span>
<a name="line-11"></a><span class='hs-definition'>getVirtSp</span>
<a name="line-12"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>stk_usg</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getStkUsage</span>
<a name="line-13"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>virtSp</span> <span class='hs-varid'>stk_usg</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-14"></a>
<a name="line-15"></a><a name="getRealSp"></a><span class='hs-definition'>getRealSp</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>FCode</span> <span class='hs-conid'>VirtualSpOffset</span>
<a name="line-16"></a><span class='hs-definition'>getRealSp</span>
<a name="line-17"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>stk_usg</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getStkUsage</span>
<a name="line-18"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>realSp</span> <span class='hs-varid'>stk_usg</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-19"></a>
<a name="line-20"></a><a name="setRealSp"></a><span class='hs-definition'>setRealSp</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>VirtualSpOffset</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Code</span>
<a name="line-21"></a><span class='hs-definition'>setRealSp</span> <span class='hs-varid'>new_real_sp</span>
<a name="line-22"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>stk_usg</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getStkUsage</span>
<a name="line-23"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>setStkUsage</span> <span class='hs-layout'>(</span><span class='hs-varid'>stk_usg</span> <span class='hs-layout'>{</span><span class='hs-varid'>realSp</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>new_real_sp</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-24"></a>
<a name="line-25"></a><a name="getSpRelOffset"></a><span class='hs-definition'>getSpRelOffset</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>VirtualSpOffset</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FCode</span> <span class='hs-conid'>CmmExpr</span>
<a name="line-26"></a><span class='hs-definition'>getSpRelOffset</span> <span class='hs-varid'>virtual_offset</span>
<a name="line-27"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>real_sp</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getRealSp</span>
<a name="line-28"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>cmmRegOffW</span> <span class='hs-varid'>spReg</span> <span class='hs-layout'>(</span><span class='hs-varid'>spRel</span> <span class='hs-varid'>real_sp</span> <span class='hs-varid'>virtual_offset</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection[CgStackery-layout]{Laying out a stack frame}
%* *
%************************************************************************
'mkVirtStkOffsets' is given a list of arguments. The first argument
gets the /largest/ virtual stack offset (remember, virtual offsets
increase towards the top of stack).
\begin{code}
<pre><a name="line-1"></a><a name="mkVirtStkOffsets"></a><span class='hs-definition'>mkVirtStkOffsets</span>
<a name="line-2"></a> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>VirtualSpOffset</span> <span class='hs-comment'>-- Offset of the last allocated thing</span>
<a name="line-3"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>CgRep</span><span class='hs-layout'>,</span><span class='hs-varid'>a</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- things to make offsets for</span>
<a name="line-4"></a> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>VirtualSpOffset</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- OUTPUTS: Topmost allocated word</span>
<a name="line-5"></a> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span> <span class='hs-conid'>VirtualSpOffset</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- things with offsets (voids filtered out)</span>
<a name="line-6"></a>
<a name="line-7"></a><span class='hs-definition'>mkVirtStkOffsets</span> <span class='hs-varid'>init_Sp_offset</span> <span class='hs-varid'>things</span>
<a name="line-8"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>loop</span> <span class='hs-varid'>init_Sp_offset</span> <span class='hs-conid'>[]</span> <span class='hs-layout'>(</span><span class='hs-varid'>reverse</span> <span class='hs-varid'>things</span><span class='hs-layout'>)</span>
<a name="line-9"></a> <span class='hs-keyword'>where</span>
<a name="line-10"></a> <span class='hs-varid'>loop</span> <span class='hs-varid'>offset</span> <span class='hs-varid'>offs</span> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>offset</span><span class='hs-layout'>,</span><span class='hs-varid'>offs</span><span class='hs-layout'>)</span>
<a name="line-11"></a> <span class='hs-varid'>loop</span> <span class='hs-varid'>offset</span> <span class='hs-varid'>offs</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-conid'>VoidArg</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span><span class='hs-conop'>:</span><span class='hs-varid'>things</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>loop</span> <span class='hs-varid'>offset</span> <span class='hs-varid'>offs</span> <span class='hs-varid'>things</span>
<a name="line-12"></a> <span class='hs-comment'>-- ignore Void arguments</span>
<a name="line-13"></a> <span class='hs-varid'>loop</span> <span class='hs-varid'>offset</span> <span class='hs-varid'>offs</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>rep</span><span class='hs-layout'>,</span><span class='hs-varid'>t</span><span class='hs-layout'>)</span><span class='hs-conop'>:</span><span class='hs-varid'>things</span><span class='hs-layout'>)</span>
<a name="line-14"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>loop</span> <span class='hs-varid'>thing_slot</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>t</span><span class='hs-layout'>,</span><span class='hs-varid'>thing_slot</span><span class='hs-layout'>)</span><span class='hs-conop'>:</span><span class='hs-varid'>offs</span><span class='hs-layout'>)</span> <span class='hs-varid'>things</span>
<a name="line-15"></a> <span class='hs-keyword'>where</span>
<a name="line-16"></a> <span class='hs-varid'>thing_slot</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>offset</span> <span class='hs-varop'>+</span> <span class='hs-varid'>cgRepSizeW</span> <span class='hs-varid'>rep</span>
<a name="line-17"></a> <span class='hs-comment'>-- offset of thing is offset+size, because we're </span>
<a name="line-18"></a> <span class='hs-comment'>-- growing the stack *downwards* as the offsets increase.</span>
<a name="line-19"></a>
<a name="line-20"></a><span class='hs-comment'>-- | 'mkStkAmodes' is a higher-level version of</span>
<a name="line-21"></a><span class='hs-comment'>-- 'mkVirtStkOffsets'. It starts from the tail-call locations.</span>
<a name="line-22"></a><span class='hs-comment'>-- It returns a single list of addressing modes for the stack</span>
<a name="line-23"></a><span class='hs-comment'>-- locations, and therefore is in the monad. It /doesn't/ adjust the</span>
<a name="line-24"></a><span class='hs-comment'>-- high water mark.</span>
<a name="line-25"></a>
<a name="line-26"></a><a name="mkStkAmodes"></a><span class='hs-definition'>mkStkAmodes</span>
<a name="line-27"></a> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>VirtualSpOffset</span> <span class='hs-comment'>-- Tail call positions</span>
<a name="line-28"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>CgRep</span><span class='hs-layout'>,</span><span class='hs-conid'>CmmExpr</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- things to make offsets for</span>
<a name="line-29"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FCode</span> <span class='hs-layout'>(</span><span class='hs-conid'>VirtualSpOffset</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- OUTPUTS: Topmost allocated word</span>
<a name="line-30"></a> <span class='hs-conid'>CmmStmts</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- Assignments to appropriate stk slots</span>
<a name="line-31"></a>
<a name="line-32"></a><span class='hs-definition'>mkStkAmodes</span> <span class='hs-varid'>tail_Sp</span> <span class='hs-varid'>things</span>
<a name="line-33"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>rSp</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getRealSp</span>
<a name="line-34"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-layout'>(</span><span class='hs-varid'>last_Sp_offset</span><span class='hs-layout'>,</span> <span class='hs-varid'>offsets</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkVirtStkOffsets</span> <span class='hs-varid'>tail_Sp</span> <span class='hs-varid'>things</span>
<a name="line-35"></a> <span class='hs-varid'>abs_cs</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span> <span class='hs-conid'>CmmStore</span> <span class='hs-layout'>(</span><span class='hs-varid'>cmmRegOffW</span> <span class='hs-varid'>spReg</span> <span class='hs-layout'>(</span><span class='hs-varid'>spRel</span> <span class='hs-varid'>rSp</span> <span class='hs-varid'>offset</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varid'>amode</span>
<a name="line-36"></a> <span class='hs-keyglyph'>|</span> <span class='hs-layout'>(</span><span class='hs-varid'>amode</span><span class='hs-layout'>,</span> <span class='hs-varid'>offset</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>offsets</span>
<a name="line-37"></a> <span class='hs-keyglyph'>]</span>
<a name="line-38"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>returnFC</span> <span class='hs-layout'>(</span><span class='hs-varid'>last_Sp_offset</span><span class='hs-layout'>,</span> <span class='hs-varid'>toOL</span> <span class='hs-varid'>abs_cs</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection[CgStackery-monadery]{Inside-monad functions for stack manipulation}
%* *
%************************************************************************
Allocate a virtual offset for something.
\begin{code}
<pre><a name="line-1"></a><a name="allocPrimStack"></a><span class='hs-definition'>allocPrimStack</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>CgRep</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FCode</span> <span class='hs-conid'>VirtualSpOffset</span>
<a name="line-2"></a><span class='hs-definition'>allocPrimStack</span> <span class='hs-varid'>rep</span>
<a name="line-3"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>stk_usg</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getStkUsage</span>
<a name="line-4"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>free_stk</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>freeStk</span> <span class='hs-varid'>stk_usg</span>
<a name="line-5"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>find_block</span> <span class='hs-varid'>free_stk</span> <span class='hs-keyword'>of</span>
<a name="line-6"></a> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-7"></a> <span class='hs-layout'>{</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>push_virt_sp</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>virtSp</span> <span class='hs-varid'>stk_usg</span> <span class='hs-varop'>+</span> <span class='hs-varid'>size</span>
<a name="line-8"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>setStkUsage</span> <span class='hs-layout'>(</span><span class='hs-varid'>stk_usg</span> <span class='hs-layout'>{</span> <span class='hs-varid'>virtSp</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>push_virt_sp</span><span class='hs-layout'>,</span>
<a name="line-9"></a> <span class='hs-varid'>hwSp</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>hwSp</span> <span class='hs-varid'>stk_usg</span> <span class='hs-varop'>`max`</span> <span class='hs-varid'>push_virt_sp</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-10"></a> <span class='hs-comment'>-- Adjust high water mark</span>
<a name="line-11"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-varid'>push_virt_sp</span> <span class='hs-layout'>}</span>
<a name="line-12"></a> <span class='hs-conid'>Just</span> <span class='hs-varid'>slot</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-13"></a> <span class='hs-layout'>{</span> <span class='hs-varid'>setStkUsage</span> <span class='hs-layout'>(</span><span class='hs-varid'>stk_usg</span> <span class='hs-layout'>{</span> <span class='hs-varid'>freeStk</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>delete_block</span> <span class='hs-varid'>free_stk</span> <span class='hs-varid'>slot</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-14"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-varid'>slot</span> <span class='hs-layout'>}</span>
<a name="line-15"></a> <span class='hs-layout'>}</span>
<a name="line-16"></a> <span class='hs-keyword'>where</span>
<a name="line-17"></a> <span class='hs-varid'>size</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>WordOff</span>
<a name="line-18"></a> <span class='hs-varid'>size</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>cgRepSizeW</span> <span class='hs-varid'>rep</span>
<a name="line-19"></a>
<a name="line-20"></a> <span class='hs-comment'>-- Find_block looks for a contiguous chunk of free slots</span>
<a name="line-21"></a> <span class='hs-comment'>-- returning the offset of its topmost word</span>
<a name="line-22"></a> <span class='hs-varid'>find_block</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>VirtualSpOffset</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Maybe</span> <span class='hs-conid'>VirtualSpOffset</span>
<a name="line-23"></a> <span class='hs-varid'>find_block</span> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Nothing</span>
<a name="line-24"></a> <span class='hs-varid'>find_block</span> <span class='hs-layout'>(</span><span class='hs-varid'>slot</span><span class='hs-conop'>:</span><span class='hs-varid'>slots</span><span class='hs-layout'>)</span>
<a name="line-25"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>take</span> <span class='hs-varid'>size</span> <span class='hs-layout'>(</span><span class='hs-varid'>slot</span><span class='hs-conop'>:</span><span class='hs-varid'>slots</span><span class='hs-layout'>)</span> <span class='hs-varop'>==</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>slot</span><span class='hs-keyglyph'>..</span><span class='hs-varid'>top_slot</span><span class='hs-keyglyph'>]</span>
<a name="line-26"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Just</span> <span class='hs-varid'>top_slot</span>
<a name="line-27"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span>
<a name="line-28"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>find_block</span> <span class='hs-varid'>slots</span>
<a name="line-29"></a> <span class='hs-keyword'>where</span> <span class='hs-comment'>-- The stack grows downwards, with increasing virtual offsets.</span>
<a name="line-30"></a> <span class='hs-comment'>-- Therefore, the address of a multi-word object is the *highest*</span>
<a name="line-31"></a> <span class='hs-comment'>-- virtual offset it occupies (top_slot below).</span>
<a name="line-32"></a> <span class='hs-varid'>top_slot</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>slot</span><span class='hs-varop'>+</span><span class='hs-varid'>size</span><span class='hs-comment'>-</span><span class='hs-num'>1</span>
<a name="line-33"></a>
<a name="line-34"></a> <span class='hs-varid'>delete_block</span> <span class='hs-varid'>free_stk</span> <span class='hs-varid'>slot</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>free_stk</span><span class='hs-layout'>,</span>
<a name="line-35"></a> <span class='hs-layout'>(</span><span class='hs-varid'>s</span><span class='hs-varop'><=</span><span class='hs-varid'>slot</span><span class='hs-comment'>-</span><span class='hs-varid'>size</span><span class='hs-layout'>)</span> <span class='hs-varop'>||</span> <span class='hs-layout'>(</span><span class='hs-varid'>s</span><span class='hs-varop'>></span><span class='hs-varid'>slot</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>]</span>
<a name="line-36"></a> <span class='hs-comment'>-- Retain slots which are not in the range</span>
<a name="line-37"></a> <span class='hs-comment'>-- slot-size+1..slot</span>
</pre>\end{code}
Allocate a chunk ON TOP OF the stack.
\begin{code}
<pre><a name="line-1"></a><a name="allocStackTop"></a><span class='hs-definition'>allocStackTop</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>WordOff</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FCode</span> <span class='hs-conid'>()</span>
<a name="line-2"></a><span class='hs-definition'>allocStackTop</span> <span class='hs-varid'>size</span>
<a name="line-3"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>stk_usg</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getStkUsage</span>
<a name="line-4"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>push_virt_sp</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>virtSp</span> <span class='hs-varid'>stk_usg</span> <span class='hs-varop'>+</span> <span class='hs-varid'>size</span>
<a name="line-5"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>setStkUsage</span> <span class='hs-layout'>(</span><span class='hs-varid'>stk_usg</span> <span class='hs-layout'>{</span> <span class='hs-varid'>virtSp</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>push_virt_sp</span><span class='hs-layout'>,</span>
<a name="line-6"></a> <span class='hs-varid'>hwSp</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>hwSp</span> <span class='hs-varid'>stk_usg</span> <span class='hs-varop'>`max`</span> <span class='hs-varid'>push_virt_sp</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
</pre>\end{code}
Pop some words from the current top of stack. This is used for
de-allocating the return address in a case alternative.
\begin{code}
<pre><a name="line-1"></a><a name="deAllocStackTop"></a><span class='hs-definition'>deAllocStackTop</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>WordOff</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FCode</span> <span class='hs-conid'>()</span>
<a name="line-2"></a><span class='hs-definition'>deAllocStackTop</span> <span class='hs-varid'>size</span>
<a name="line-3"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>stk_usg</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getStkUsage</span>
<a name="line-4"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>pop_virt_sp</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>virtSp</span> <span class='hs-varid'>stk_usg</span> <span class='hs-comment'>-</span> <span class='hs-varid'>size</span>
<a name="line-5"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>setStkUsage</span> <span class='hs-layout'>(</span><span class='hs-varid'>stk_usg</span> <span class='hs-layout'>{</span> <span class='hs-varid'>virtSp</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>pop_virt_sp</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
</pre>\end{code}
\begin{code}
<pre><a name="line-1"></a><a name="adjustStackHW"></a><span class='hs-definition'>adjustStackHW</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>VirtualSpOffset</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Code</span>
<a name="line-2"></a><span class='hs-definition'>adjustStackHW</span> <span class='hs-varid'>offset</span>
<a name="line-3"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>stk_usg</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getStkUsage</span>
<a name="line-4"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>setStkUsage</span> <span class='hs-layout'>(</span><span class='hs-varid'>stk_usg</span> <span class='hs-layout'>{</span> <span class='hs-varid'>hwSp</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>hwSp</span> <span class='hs-varid'>stk_usg</span> <span class='hs-varop'>`max`</span> <span class='hs-varid'>offset</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
</pre>\end{code}
A knot-tying beast.
\begin{code}
<pre><a name="line-1"></a><a name="getFinalStackHW"></a><span class='hs-definition'>getFinalStackHW</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>VirtualSpOffset</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Code</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Code</span>
<a name="line-2"></a><span class='hs-definition'>getFinalStackHW</span> <span class='hs-varid'>fcode</span>
<a name="line-3"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>fixC_</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>hw_sp</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-4"></a> <span class='hs-layout'>{</span> <span class='hs-varid'>fcode</span> <span class='hs-varid'>hw_sp</span>
<a name="line-5"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>stk_usg</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getStkUsage</span>
<a name="line-6"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>hwSp</span> <span class='hs-varid'>stk_usg</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-7"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-conid'>()</span> <span class='hs-layout'>}</span>
</pre>\end{code}
\begin{code}
<pre><a name="line-1"></a><a name="setStackFrame"></a><span class='hs-definition'>setStackFrame</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>VirtualSpOffset</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Code</span>
<a name="line-2"></a><span class='hs-definition'>setStackFrame</span> <span class='hs-varid'>offset</span>
<a name="line-3"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>stk_usg</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getStkUsage</span>
<a name="line-4"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>setStkUsage</span> <span class='hs-layout'>(</span><span class='hs-varid'>stk_usg</span> <span class='hs-layout'>{</span> <span class='hs-varid'>frameSp</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>offset</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-5"></a>
<a name="line-6"></a><a name="getStackFrame"></a><span class='hs-definition'>getStackFrame</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>FCode</span> <span class='hs-conid'>VirtualSpOffset</span>
<a name="line-7"></a><span class='hs-definition'>getStackFrame</span>
<a name="line-8"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>stk_usg</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getStkUsage</span>
<a name="line-9"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>frameSp</span> <span class='hs-varid'>stk_usg</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
</pre>\end{code}
%********************************************************
%* *
%* Setting up update frames *
%* *
%********************************************************
@pushUpdateFrame@ $updatee$ pushes a general update frame which
points to $updatee$ as the thing to be updated. It is only used
when a thunk has just been entered, so the (real) stack pointers
are guaranteed to be nicely aligned with the top of stack.
@pushUpdateFrame@ adjusts the virtual and tail stack pointers
to reflect the frame pushed.
\begin{code}
<pre><a name="line-1"></a><a name="pushUpdateFrame"></a><span class='hs-definition'>pushUpdateFrame</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>CmmExpr</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Code</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Code</span>
<a name="line-2"></a><span class='hs-definition'>pushUpdateFrame</span> <span class='hs-varid'>updatee</span> <span class='hs-varid'>code</span>
<a name="line-3"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span>
<a name="line-4"></a> <span class='hs-varid'>when</span> <span class='hs-varid'>debugIsOn</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span>
<a name="line-5"></a> <span class='hs-layout'>{</span> <span class='hs-conid'>EndOfBlockInfo</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>sequel</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getEndOfBlockInfo</span> <span class='hs-layout'>;</span>
<a name="line-6"></a> <span class='hs-layout'>;</span> <span class='hs-conid'>MASSERT</span><span class='hs-layout'>(</span><span class='hs-keyword'>case</span> <span class='hs-varid'>sequel</span> <span class='hs-keyword'>of</span> <span class='hs-layout'>{</span> <span class='hs-conid'>OnStack</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>True</span><span class='hs-layout'>;</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>False</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-7"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>allocStackTop</span> <span class='hs-layout'>(</span><span class='hs-varid'>fixedHdrSize</span> <span class='hs-varop'>+</span>
<a name="line-8"></a> <span class='hs-varid'>sIZEOF_StgUpdateFrame_NoHdr</span> <span class='hs-varop'>`quot`</span> <span class='hs-varid'>wORD_SIZE</span><span class='hs-layout'>)</span>
<a name="line-9"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>vsp</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getVirtSp</span>
<a name="line-10"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>setStackFrame</span> <span class='hs-varid'>vsp</span>
<a name="line-11"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>frame_addr</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getSpRelOffset</span> <span class='hs-varid'>vsp</span>
<a name="line-12"></a> <span class='hs-comment'>-- The location of the lowest-address</span>
<a name="line-13"></a> <span class='hs-comment'>-- word of the update frame itself</span>
<a name="line-14"></a>
<a name="line-15"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>setEndOfBlockInfo</span> <span class='hs-layout'>(</span><span class='hs-conid'>EndOfBlockInfo</span> <span class='hs-varid'>vsp</span> <span class='hs-conid'>UpdateCode</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span>
<a name="line-16"></a> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>emitPushUpdateFrame</span> <span class='hs-varid'>frame_addr</span> <span class='hs-varid'>updatee</span>
<a name="line-17"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>code</span> <span class='hs-layout'>}</span>
<a name="line-18"></a> <span class='hs-layout'>}</span>
<a name="line-19"></a>
<a name="line-20"></a><a name="emitPushUpdateFrame"></a><span class='hs-definition'>emitPushUpdateFrame</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>CmmExpr</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CmmExpr</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Code</span>
<a name="line-21"></a><span class='hs-definition'>emitPushUpdateFrame</span> <span class='hs-varid'>frame_addr</span> <span class='hs-varid'>updatee</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-22"></a> <span class='hs-varid'>stmtsC</span> <span class='hs-keyglyph'>[</span> <span class='hs-comment'>-- Set the info word</span>
<a name="line-23"></a> <span class='hs-conid'>CmmStore</span> <span class='hs-varid'>frame_addr</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkLblExpr</span> <span class='hs-varid'>mkUpdInfoLabel</span><span class='hs-layout'>)</span>
<a name="line-24"></a> <span class='hs-layout'>,</span> <span class='hs-comment'>-- And the updatee</span>
<a name="line-25"></a> <span class='hs-conid'>CmmStore</span> <span class='hs-layout'>(</span><span class='hs-varid'>cmmOffsetB</span> <span class='hs-varid'>frame_addr</span> <span class='hs-varid'>off_updatee</span><span class='hs-layout'>)</span> <span class='hs-varid'>updatee</span> <span class='hs-keyglyph'>]</span>
<a name="line-26"></a> <span class='hs-varid'>initUpdFrameProf</span> <span class='hs-varid'>frame_addr</span>
<a name="line-27"></a>
<a name="line-28"></a><a name="off_updatee"></a><span class='hs-definition'>off_updatee</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ByteOff</span>
<a name="line-29"></a><span class='hs-definition'>off_updatee</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fixedHdrSize</span><span class='hs-varop'>*</span><span class='hs-varid'>wORD_SIZE</span> <span class='hs-varop'>+</span> <span class='hs-varid'>oFFSET_StgUpdateFrame_updatee</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection[CgStackery-free]{Free stack slots}
%* *
%************************************************************************
Explicitly free some stack space.
\begin{code}
<pre><a name="line-1"></a><a name="freeStackSlots"></a><span class='hs-definition'>freeStackSlots</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>VirtualSpOffset</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Code</span>
<a name="line-2"></a><span class='hs-definition'>freeStackSlots</span> <span class='hs-varid'>extra_free</span>
<a name="line-3"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>stk_usg</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getStkUsage</span>
<a name="line-4"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>all_free</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>addFreeSlots</span> <span class='hs-layout'>(</span><span class='hs-varid'>freeStk</span> <span class='hs-varid'>stk_usg</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>sortLe</span> <span class='hs-layout'>(</span><span class='hs-varop'><=</span><span class='hs-layout'>)</span> <span class='hs-varid'>extra_free</span><span class='hs-layout'>)</span>
<a name="line-5"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-layout'>(</span><span class='hs-varid'>new_vsp</span><span class='hs-layout'>,</span> <span class='hs-varid'>new_free</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>trim</span> <span class='hs-layout'>(</span><span class='hs-varid'>virtSp</span> <span class='hs-varid'>stk_usg</span><span class='hs-layout'>)</span> <span class='hs-varid'>all_free</span>
<a name="line-6"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>setStkUsage</span> <span class='hs-layout'>(</span><span class='hs-varid'>stk_usg</span> <span class='hs-layout'>{</span> <span class='hs-varid'>virtSp</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>new_vsp</span><span class='hs-layout'>,</span> <span class='hs-varid'>freeStk</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>new_free</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-7"></a>
<a name="line-8"></a><a name="addFreeSlots"></a><span class='hs-definition'>addFreeSlots</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>VirtualSpOffset</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>VirtualSpOffset</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>VirtualSpOffset</span><span class='hs-keyglyph'>]</span>
<a name="line-9"></a><span class='hs-comment'>-- Merge the two, assuming both are in increasing order</span>
<a name="line-10"></a><span class='hs-definition'>addFreeSlots</span> <span class='hs-varid'>cs</span> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>cs</span>
<a name="line-11"></a><span class='hs-definition'>addFreeSlots</span> <span class='hs-conid'>[]</span> <span class='hs-varid'>ns</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ns</span>
<a name="line-12"></a><span class='hs-definition'>addFreeSlots</span> <span class='hs-layout'>(</span><span class='hs-varid'>c</span><span class='hs-conop'>:</span><span class='hs-varid'>cs</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>n</span><span class='hs-conop'>:</span><span class='hs-varid'>ns</span><span class='hs-layout'>)</span>
<a name="line-13"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>c</span> <span class='hs-varop'><</span> <span class='hs-varid'>n</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>c</span> <span class='hs-conop'>:</span> <span class='hs-varid'>addFreeSlots</span> <span class='hs-varid'>cs</span> <span class='hs-layout'>(</span><span class='hs-varid'>n</span><span class='hs-conop'>:</span><span class='hs-varid'>ns</span><span class='hs-layout'>)</span>
<a name="line-14"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>n</span> <span class='hs-conop'>:</span> <span class='hs-varid'>addFreeSlots</span> <span class='hs-layout'>(</span><span class='hs-varid'>c</span><span class='hs-conop'>:</span><span class='hs-varid'>cs</span><span class='hs-layout'>)</span> <span class='hs-varid'>ns</span>
<a name="line-15"></a>
<a name="line-16"></a><a name="trim"></a><span class='hs-definition'>trim</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>VirtualSpOffset</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>VirtualSpOffset</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>VirtualSpOffset</span><span class='hs-layout'>,</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>VirtualSpOffset</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-17"></a><span class='hs-comment'>-- Try to trim back the virtual stack pointer, where there is a</span>
<a name="line-18"></a><span class='hs-comment'>-- continuous bunch of free slots at the end of the free list</span>
<a name="line-19"></a><span class='hs-definition'>trim</span> <span class='hs-varid'>vsp</span> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>vsp</span><span class='hs-layout'>,</span> <span class='hs-conid'>[]</span><span class='hs-layout'>)</span>
<a name="line-20"></a><span class='hs-definition'>trim</span> <span class='hs-varid'>vsp</span> <span class='hs-layout'>(</span><span class='hs-varid'>slot</span><span class='hs-conop'>:</span><span class='hs-varid'>slots</span><span class='hs-layout'>)</span>
<a name="line-21"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>trim</span> <span class='hs-varid'>vsp</span> <span class='hs-varid'>slots</span> <span class='hs-keyword'>of</span>
<a name="line-22"></a> <span class='hs-layout'>(</span><span class='hs-varid'>vsp'</span><span class='hs-layout'>,</span> <span class='hs-conid'>[]</span><span class='hs-layout'>)</span>
<a name="line-23"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>vsp'</span> <span class='hs-varop'><</span> <span class='hs-varid'>slot</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>pprTrace</span> <span class='hs-str'>"trim: strange"</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>vsp</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-layout'>(</span><span class='hs-varid'>slot</span><span class='hs-conop'>:</span><span class='hs-varid'>slots</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-24"></a> <span class='hs-layout'>(</span><span class='hs-varid'>vsp'</span><span class='hs-layout'>,</span> <span class='hs-conid'>[]</span><span class='hs-layout'>)</span>
<a name="line-25"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>vsp'</span> <span class='hs-varop'>==</span> <span class='hs-varid'>slot</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>vsp'</span><span class='hs-comment'>-</span><span class='hs-num'>1</span><span class='hs-layout'>,</span> <span class='hs-conid'>[]</span><span class='hs-layout'>)</span>
<a name="line-26"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>vsp'</span><span class='hs-layout'>,</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>slot</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-27"></a> <span class='hs-layout'>(</span><span class='hs-varid'>vsp'</span><span class='hs-layout'>,</span> <span class='hs-varid'>slots'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>vsp'</span><span class='hs-layout'>,</span> <span class='hs-varid'>slot</span><span class='hs-conop'>:</span><span class='hs-varid'>slots'</span><span class='hs-layout'>)</span>
</pre>\end{code}
</body>
</html>
