Artifact b1ac91bb47cae245877e74bf9921775615aa97d8720ce8d152c995fc4f1ec537:

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

• File psl-1983/kernel/binding.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: 2489) [annotate] [blame] [check-ins using]

%
% BINDING.RED - Primitives to support Lambda binding
% 
% Author:      Eric Benson
%	       Symbolic Computation Group
%              Computer Science Dept.
%              University of Utah
% Date:        18 August 1981
% Copyright (c) 1981 University of Utah
%

%  <PSL.KERNEL>BINDING.RED.2, 21-Dec-82 15:57:06, Edit by BENSON
%  Added call to %clear-catch-stack in ClearBindings

% Support for binding in compiled code is in FAST-BINDER.RED

on SysLisp;

internal WConst BndStkSize = 2000;

internal WArray BndStk[BndStkSize];

% Only these WVars, which contain addresses rather than indexes, will be
% used to access the binding stack

exported WVar BndStkLowerBound = &BndStk[0],
	      BndStkUpperBound = &BndStk[BndStkSize-1],
	      BndStkPtr = &BndStk[0];

% Only the macros BndStkID, BndStkVal and AdjustBndStkPtr will be used
% to access or modify the binding stack and pointer.

syslsp procedure BStackOverflow();
<<  ChannelPrin2(LispVar ErrOUT!*,
		 "***** Binding stack overflow, restarting...");
    ChannelWriteChar(LispVar ErrOUT!*,
		     char EOL);
    Reset() >>;

syslsp procedure BStackUnderflow();
<<  ChannelPrin2(LispVar ErrOUT!*,
		 "***** Binding stack underflow, restarting...");
    ChannelWriteChar(LispVar ErrOUT!*,
		     char EOL);
    Reset() >>;

syslsp procedure CaptureEnvironment();	 %. Save bindings to be restored
    BndStkPtr;

syslsp procedure RestoreEnvironment Ptr;	%. Restore old bindings
<<  if Ptr < BndStkLowerBound then BStackUnderflow()
    else while BndStkPtr > Ptr do
    <<  SymVal BndStkID BndStkPtr := BndStkVal BndStkPtr;
	BndStkPtr := AdjustBndStkPtr(BndStkPtr, -1) >> >>;

syslsp procedure ClearBindings();	 %. Restore bindings to top level
<<  RestoreEnvironment BndStkLowerBound;
    !%clear!-catch!-stack() >>;

syslsp procedure UnBindN N;		%. Support for Lambda and Prog interp
    RestoreEnvironment AdjustBndStkPtr(BndStkPtr, -IntInf N);

syslsp procedure LBind1(IDName, ValueToBind);	%. Support for Lambda
    if not IDP IDName then
	NonIDError(IDName, "binding")
    else if null IDName or IDName eq 'T then
	StdError '"T and NIL cannot be rebound"
    else
    <<  BndStkPtr := AdjustBndStkPtr(BndStkPtr, 1);
	if BndStkPtr > BndStkUpperBound then BStackOverflow()
	else
	<<  IDName := IDInf IDName;
	    BndStkID BndStkPtr := IDName;
	    BndStkVal BndStkPtr := SymVal IDName;
	    SymVal IDName := ValueToBind >> >>;

syslsp procedure PBind1 IDName;		%. Support for PROG
    LBind1(IDName, NIL);

off SysLisp;

END;