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