1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2%
3% File:           PXK:BPS-HEAP.SL
4% Title:          Low level memory management
5% Author:         Herbert Melenk, Konrad-Zuse_zentrum Berlin
6% Created:        07-Nov-89
7% Modified:
8% Status:         Open Source: BSD License
9% Mode:           Lisp
10% Package:        Kernel
11%
12% Redistribution and use in source and binary forms, with or without
13% modification, are permitted provided that the following conditions are met:
14%
15%    * Redistributions of source code must retain the relevant copyright
16%      notice, this list of conditions and the following disclaimer.
17%    * Redistributions in binary form must reproduce the above copyright
18%      notice, this list of conditions and the following disclaimer in the
19%      documentation and/or other materials provided with the distribution.
20%
21% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
22% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
23% THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
24% PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNERS OR
25% CONTRIBUTORS
26% BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
27% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
28% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
29% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
30% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
31% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
32% POSSIBILITY OF SUCH DAMAGE.
33%
34%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
35%
36% Revisions:
37%
38%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
39
40% this version provides for a two heap model (copying GC)
41
42(de init-pointers()
43
44    % stack is initialized already by _main
45
46    % catch stack
47  (setq catchstackptr catchstack)
48
49    % bndstack
50  %  is a constant for now: (setq bndstksize (segmentlength bndstk))
51  (setq bndstklowerbound bndstk)
52  (setq bndstkupperbound (loc (wgetv bndstk (wdifference bndstksize 1))))
53  (setq bndstkptr bndstk)
54
55    % bps
56    % nextbps is inherited, but must be relocated
57  (setq bpssize (segmentlength bps))
58  (setq nextbps (wplus2 addressingunitsperitem
59                (relocfromload (wdifference nextbps
60                                        addressingunitsperitem))))
61  (setq lastbps (wplus2 bps bpssize))
62
63    % heap
64  (setq heapsize (segmentlength heap))
65  (setq heapsize (wquotient heapsize 2))
66    % the heap pointers for first heap
67  (setq heaplowerbound heap)
68  (setq heapupperbound (wplus2 heap heapsize))
69  (setq heaplast heaplowerbound)
70  (setq heaptrapbound (wdifference heapupperbound 120))
71
72    % the heap pointers for second heap
73  (setq oldheaplowerbound heapupperbound)
74  (setq oldheapupperbound (wplus2 oldheaplowerbound heapsize))
75  (setq oldheaplast oldheaplowerbound)
76  (setq oldheaptrapbound oldheapupperbound)
77)
78
79(de alterheapsize(d)
80    (setq d (wplus2 d d))
81    (let ((u (enlarge_memory d))
82	  (d2 (wquotient d 2)))
83	(if (wlessp u 0) -1
84	 (progn
85		(setq heapsize (plus heapsize d2))
86		(setq heapupperbound (plus heapupperbound d2))
87		(setq heaptrapbound (wdifference heapupperbound 120))
88
89		(setq oldheaplowerbound heapupperbound)
90		(setq oldheaplast oldheaplowerbound)
91		(setq oldheaptrapbound oldheapupperbound)))))
92
93