Artifact 7938b8bece2d02a4baf4c3b322b738410a16781eb928597fdc2a66cf19d3152c:

• File psl-1983/3-1/tests/mini-oblist.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: 1748) [annotate] [blame] [check-ins using] [more...]

%F PT MINI-OBLIST RED  18-MAR-83

on syslisp;

internal WConst DeletedSlotValue = -1,
		EmptySlotValue = 0;


syslsp procedure Intern s;
 % Lookup string, find old ID or return a new one
 Begin scalar D;
  If IDP s then s :=SymNam IdInf s;
  If (D:=LookupString( s)) then return MkItem(ID,D);
  Return NewId s;
End;

syslsp procedure NewId S;
   InitNewId(GtId(),s);

Syslsp procedure InitNewId(D,s);
Begin
  If LispVar(DEBUG) then <<Prin2 '"New ID# ";  Print D>>;
  Symval(D):=NIL;
  SymPrp(D):=NIL;
  SymNam(D):=s;
  D:=MkItem(ID,D);
  MakeFUnBound(D); % Machine dependent, in XXX-HEADER
  Obarray(D):=D;   % For GC hook
  Return D;
 End;


Syslsp procedure LookupString(s);
 % Linear scan of SYMNAM field to find string s
 Begin scalar D;
     D:=NextSymbol;
     If LispVar(DEBUG) then  
       <<Prin2 '"Lookup string=";Prin1String s; Terpri()>>;
  L: If D<=0 then  return
        <<If LispVar(DEBUG) then Prin2T '"Not Found in LookupString";  
          NIL>>;
      D:=D-1;
      If EqStr(SymNam(D),s) then return 
        <<If LispVar(DEBUG) then <<Prin2 '"Found In LookupString="; print D>>;
          D>>;
    goto L
  End;


% ---- Small MAPOBL and printers


Syslsp procedure MapObl(Fn);
 For i:=0:NextSymbol-1 do IdApply1(MkItem(ID,I),Fn);

Syslsp procedure PrintFexprs;
 MapObl 'Print1Fexpr;

Syslsp procedure Print1Fexpr(x);
 If FexprP x then Print x;

Syslsp procedure PrintFunctions;
 MapObl 'Print1Function;

Syslsp procedure Print1Function(x);
 If Not FUnboundP x then Print x;

syslisp procedure InitObList();
% Dummy, non hashed version
 Begin scalar Tmp;
	For i:=0 step 1 until MaxObarray do
	  ObArray I := EmptySlotValue;
	Tmp:= NextSymbol -1;
	For I := 128 step 1 until Tmp do
	  ObArray I := I;
  End;

off syslisp;

End;