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