Artifact 93f5fbca07a58e4643192735cd57a0c841aec5e6966cd52e9a0cb24ccb4da630:

• File psl-1983/3-1/kernel/20/dumplisp.red — part of check-in [eb17ceb7f6] at 2020-04-21 19:40:01 on branch master — Add Reduce 3.0 to the historical section of the archive, and some more
  files relating to version sof PSL from the early 1980s. Thanks are due to
  Paul McJones and Nelson Beebe for these, as well as to all the original
  authors.

  git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 2396) [annotate] [blame] [check-ins using] [more...]

%
% DUMPLISP.RED - Dump running Lisp into a file
% 
% Author:      Eric Benson
%              Symbolic Computation Group
%              Computer Science Dept.
%              University of Utah
% Date:        25 April 1982
% Copyright (c) 1982 University of Utah
%

%  27-May-83 Mark R. Swanson
%  Changes for extended addressing
%  <PSL.KERNEL-20>DUMPLISP.RED.2,  5-Oct-82 10:57:34, Edit by BENSON
%  Removed DumpFileName!* added filename arg to Dumplisp
%  <PSL.20-INTERP>DUMPLISP.RED.7,  3-Sep-82 10:22:46, Edit by BENSON
%  Fixed page boundary bug when unmapping stack

CompileTime <<

flag('(unmap!-pages save!-into!-file), 'InternalFunction);

>>;

on Syslisp;

external WVar ST, HeapLast, HeapUpperBound, NextBPS, LastBPS, StackUpperBound;

syslsp procedure DumpLisp Filename;
<<  if not StringP Filename then
	StdError "Dumplisp requires a filename argument";
    Reclaim;
    unmap!-space(HeapLast, HeapUpperBound);
    unmap!-space(NextBPS, LastBPS);
    %% Add some slack to the end of the stack fo the call to unmap-space!
    unmap!-space(MakeAddressFromStackPointer ST + 10, StackUpperBound);
    save!-into!-file Filename >>;

syslsp procedure unmap!-space(Lo, Hi);
begin scalar LoPage, HiPage;
    LoPage := LSH(Lo + 8#777, -9);
    HiPage := LSH(Hi - 8#1000, -9);
    return if not (LoPage >= HiPage) then
	unmap!-pages(LoPage, HiPage - LoPage);
end;

lap '((!*entry unmap!-pages expr 2)
	(hrlzi 3 2#100000000000000000)	% pm%cnt in AC3
	(hrr 3 2)			% page count in rh AC3
	(hrlzi 2 8#400000)		% .fhslf in lh AC2
	(hrr 2 1)			% starting page in rh AC2
	(!*MOVE (WConst -1) (REG 1))	% -1 in AC1
	(pmap)				% do it
	(!*EXIT 0)
);

lap '((!*entry save!-into!-file expr 1)
	(!*MOVE (reg 1) (reg 5))	% save in 5
	(move 2 1)			% file name in 2
	(!*MkItem (reg 2) 8#66)         % make a byte pointer
	(hrlzi 1 2#100000000000000001)	% gj%fou + gj%sht
	(gtjfn)
	 (jrst CouldntOpen)
	(hrli 1 8#400000)		% .fhslf
	(hrrzi 2 2#101011000000000000)	% ss%cpy, ss%rd, ss%exe, ss%e??,all pages
%	(hrli 2 -8#1000)		% for Release 4 and before, 1000 pages
%/ Change previous line to following line for extended addressing
 	(tlo 2 8#400000)		% large negative number
	(!*MOVE (WConst 8#1000) (REG 3))
	(ssave)
	(!*MOVE (WConst 0) (REG 1))
	(!*EXIT 0)
CouldntOpen
	(!*MOVE '"Couldn't GTJFN `%w' for Dumplisp" (reg 1))
	(!*MOVE (reg 5) (reg 2))
	(!*CALL BldMsg)
	(!*JCALL StdError)
);

off Syslisp;

END;