Artifact a8d335b0965f261301654fae8920c9d9ae7cd15ac9693d4370a8ac5d06125b44:

• File psl-1983/3-1/kernel/20/system-faslin.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: 2119) [annotate] [blame] [check-ins using] [more...]

%
% 20-FASLIN.RED - Functions needed by faslin
% 
% Author:      Eric Benson
%	       Symbolic Computation Group
%              Computer Science Dept.
%              University of Utah
% Date:        21 April 1982
% Copyright (c) 1982 University of Utah
%

%  21-May-83  Mark R. Swanson
%    Changed reference to &SYMFNC in FunctionCellLocation to be an explicit
%    array reference.
%  <PSL.KERNEL-20>SYSTEM-FASLIN.RED.4,  7-Oct-82 13:37:56, Edit by BENSON
%  Changed 0 byte size to 36 byte size, for Tenex compatibility

on Syslisp;

syslsp procedure BinaryOpenRead FileName;
begin scalar F;
    F := Dec20Open(FileName,
		     %  gj%old	    gj%sht
		     2#001000000000000001000000000000000000,
		     % 36*of%bsz	of%rd
		     2#100100000000000000010000000000000000);
    return if F eq 0 then
	ContError(99, "Couldn't open binary file for input",
			BinaryOpenRead FileName)
    else F;
end;

syslsp procedure BinaryOpenWrite FileName;
begin scalar F;
    F := Dec20Open(FileName,
		    % gj%fou gj%new gj%sht
		    2#110000000000000001000000000000000000,
		    % 36*of%bsz		of%wr
		    2#100100000000000000001000000000000000);
    return if F eq 0 then
	ContError(99, "Couldn't open binary file for output",
			BinaryOpenWrite FileName)
    else F;
end;

syslsp procedure ValueCellLocation X;
    if not LispVar !*WritingFaslFile then
	&SymVal IDInf X
    else
    <<  LispVar NewBitTableEntry!* := const RELOC_HALFWORD;
	MakeRelocHalfWord(const RELOC_VALUE_CELL, FindIDNumber X) >>;

syslsp procedure ExtraRegLocation X;
<<  X := second X;
    if not LispVar !*WritingFaslFile then
	&ArgumentBlock[X - (MaxRealRegs + 1)]
    else
    <<  LispVar NewBitTableEntry!* := const RELOC_HALFWORD;
	MakeRelocHalfWord(const RELOC_VALUE_CELL, X + 8150) >> >>;

syslsp procedure FunctionCellLocation X;
    if not LispVar !*WritingFaslFile then
	&SymFnc[IDInf X]    % different from VALUECELLLOCATION because of
			    % strange interaction with SymFnc as a function?
    else
    <<  LispVar NewBitTableEntry!* := const RELOC_HALFWORD;
	MakeRelocHalfWord(const RELOC_FUNCTION_CELL, FindIDNumber X) >>;

off SysLisp;

END;