1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2%
3% File:         PXNK:DUMPLISP.SL
4% Description:  Dump running lisp to an a.out format file.
5% Author:       RAM, HP/FSD
6% Created:      27-Feb-84
7% Modified:     14-Jan-85 09:10:20 (Vicki O'Day)
8% Status:       Open Source: BSD License
9% Mode:         Lisp
10% Package:
11%
12% (c) Copyright 1982, University of Utah
13%
14% Redistribution and use in source and binary forms, with or without
15% modification, are permitted provided that the following conditions are met:
16%
17%    * Redistributions of source code must retain the relevant copyright
18%      notice, this list of conditions and the following disclaimer.
19%    * Redistributions in binary form must reproduce the above copyright
20%      notice, this list of conditions and the following disclaimer in the
21%      documentation and/or other materials provided with the distribution.
22%
23% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
24% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
25% THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
26% PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNERS OR
27% CONTRIBUTORS
28% BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
29% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
30% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
31% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
32% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
33% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
34% POSSIBILITY OF SUCH DAMAGE.
35%
36%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
37%
38% Revisions:
39% 31-Aug-88 (Julian Padget)
40%  Changed second "fluid" call to "global" since there was no need of former.
41% 01-Jun-87 (Leigh Stoller & Harold Carr)
42%  Unbundled dumplisp.
43% 19-Dec-86 (Leigh Stoller)
44%  Unexec now moves the text/data boundary. See bps.c in the $pb directory
45%   for a full explanation.
46% 09-Dec-86 (Leigh Stoller)
47%  Removed calls to expand_file_name and put them into c-code. Problems with
48%   malloc. Commentted out seconf reclaim calls for copying-gc. This needs to
49%   be looked at. Should be an easier way to switch.
50% 24-Nov-86 (Leigh Stoller)
51%  Added calls to expand_file_name so that ~ and $ variables can be used in
52%   .sl scripts to build bare-psl.
53% 28-Dec-84 (Vicki O'Day)
54%  Decided not to use nextbps; we may want to use shared Nmode
55%  executables, and this would be very dangerous with some bps
56%  in text area.
57% 17-Oct-84 12:18:31 (RAM)
58%  Now use NEXTBPS and HEAPLAST.  This works now that setupbpsandheap does
59%  an initial malloc and free for some scratch space for library calls.
60% 27-Feb-84 16:11:36 (RAM)
61%  Print error messages from here, not from the foreign function unexec.
62%  Don't call unexec with NEXTBPS and HEAPLAST (use 0's).  There seem to be
63%  bugs when these are used.
64%
65%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
66
67(fluid '(symbolfilename* gcknt* gctime* ))
68
69(setq symbolfilename* "$pxk/bpsl")
70
71(global '(nextbps heaplast heapupperbound oldheapupperbound stacklowerbound))
72
73(compiletime (flag '(dumplispaux ) 'internalfunction))
74
75(de dumplisp (filename)
76%  (move-regs-to-mem)
77  (dumplispaux filename nextbps heaplast))
78
79(de dumplispaux (filename data-start bss-start)
80  (prog (savedstacklowerbound unexecresult savedunixargs x28
81         bpslowerbound bpssize bpscontrol)
82        (setq bpscontrol (unexec)) % read vector from C routines
83        (setq bpslowerbound (getmem bpscontrol))
84        (setq bpssize (getmem (wplus2 bpscontrol addressingunitsperitem)))
85        (setq x28 28)
86        (unless (stringp filename)
87          (stderror "Dumplisp requires a filename argument"))
88        (reclaim)
89    (if (greaterp oldheaplowerbound 0)
90      (progn
91         (reclaim)
92         (when (greaterp heapupperbound oldheapupperbound)
93               (reclaim)))
94) %%	 (compactheap))
95    (setq savedunixargs unixargs*)    % Force each new system to get
96    (setq unixargs* nil)              % its own args
97        % must be 0 for a new file
98        (setq gcknt* 0 gctime* 0)
99        (setq unexecresult (binaryopenwrite (bldmsg "%w.img" filename)))
100	(binarywriteblock unexecresult bpscontrol 2)
101        (binarywrite unexecresult (times 8 5 maxsymbols))
102        (binarywrite unexecresult (wplus2 (wdifference heaplast heaplowerbound) 24))
103        (binarywrite unexecresult (times (quotient (plus2 3 hash-table-size) 4) 16))
104        (binarywrite unexecresult bpssize)
105        (binarywriteblock unexecresult SYMVAL (times 5 maxsymbols))
106        (binarywriteblock unexecresult heaplowerbound
107		(wshift (wplus2 (wdifference heaplast heaplowerbound) 24) -3))
108        (binarywriteblock unexecresult hashtable
109                         (times 2 (quotient (plus2 3 hash-table-size) 4)))
110        (binarywriteblock unexecresult bpslowerbound
111                (wshift bpssize -3))
112        (binaryclose unexecresult)
113))
114
115%% End of File.
116
117
118
119