Artifact b84e512eaa3dc5742b4f05fe9dca2558dc2d58ca2860cdea15450ecab19b55be:

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

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

%
% TYPE-CONVERSIONS.RED - Functions for converting between various data types
% 
% Author:      Eric Benson
%	       Symbolic Computation Group
%              Computer Science Dept.
%              University of Utah
% Date:        28 August 1981
% Copyright (c) 1981 University of Utah

%  <PSL.VAX-INTERP>TYPE-CONVERSIONS.RED.2, 20-Jan-82 02:10:24, Edit by GRISS
%  Fix list2vector for NIL case

% The functions in this file are named `argument-type'2`result-type'.
% The number 2 is used rather than `To' only for compatibility with old
% versions.  Any other suggestions for a consistent naming scheme are welcomed.
% Perhaps they should also be `result-type'From`argument-type'.

% Float and Fix are in ARITH.RED

CompileTime flag('(Sys2FIXN), 'InternalFunction);

on SysLisp;

syslsp procedure ID2Int U;		%. Return ID index as Lisp number
    if IDP U then MkINT IDInf U
    else NonIDError(U, 'ID2Int);

syslsp procedure Int2ID U;		%. Return ID corresponding to index
begin scalar StripU;
    return if IntP U then
    <<  StripU := IntInf U;
	if StripU >= 0 then MkID StripU
	else TypeError(U, 'Int2ID, '"positive integer") >>
    else NonIntegerError(U, 'Int2ID);
end;

syslsp procedure Int2Sys N;		%. Convert Lisp integer to untagged
    if IntP N then IntInf N
    else if FixNP N then FixVal FixInf N
    else NonIntegerError(N, 'Int2Sys);

syslsp procedure Lisp2Char U;		%. Convert Lisp item to syslsp char
begin scalar C;				% integers, IDs and strings are legal
    return if IntP U and (C := IntInf U) >= 0 and C <= 127 then C
    else if IDP U then			% take first char of ID print name
	StrByt(StrInf SymNam IDInf U, 0)
    else if StringP U then
	StrByt(StrInf U, 0)	% take first character of Lisp string
    else NonCharacterError(U, 'Lisp2Char);
end;

syslsp procedure Int2Code N;		%. Convert Lisp integer to code pointer
    MkCODE N;

syslsp procedure Sys2Int N;		%. Convert word to Lisp number
    if SignedField(N, InfStartingBit - 1, InfBitLength + 1) eq N then N
    else Sys2FIXN N;

syslsp procedure Sys2FIXN N;
begin scalar FX;
    FX := GtFIXN();
    FixVal FX := N;
    return MkFIXN FX;
end;

syslsp procedure ID2String U;		%. Return print name of U (not copy)
    if IDP U then SymNam IDInf U
    else NonIDError(U, 'ID2String);

% The functions for converting strings to IDs are Intern and NewID.  Intern
% returns an interned ID, NewID returns an uninterned ID. They are both found
% in OBLIST.RED

syslsp procedure String2Vector U;	%. Make vector of ASCII values in U
    if StringP U then begin scalar StripU, V, N;
	N := StrLen StrInf U;
	V := GtVECT N;
	StripU := StrInf U;			% in case GC occurred
	for I := 0 step 1 until N do
	    VecItm(V, I) := MkINT StrByt(StripU, I);
	return MkVEC V;
    end else NonStringError(U, 'String2Vector);

syslsp procedure Vector2String V;	%. Make string with ASCII values in V
    if VectorP V then begin scalar StripV, S, N, Ch;
	N := VecLen VecInf V;
	S := GtSTR N;
	StripV := VecInf V;			% in case GC occurred
	for I := 0 step 1 until N do
	    StrByt(S, I) := Lisp2Char VecItm(StripV, I);
	return MkSTR S;
    end else NonVectorError(V, 'Vector2String);

syslsp procedure List2String P;		%. Make string with ASCII values in P
    if null P then '""
    else if PairP P then begin scalar S, N;
	N := IntInf Length P - 1;
	S := GtSTR N;
	for I := 0 step 1 until N do
	<<  StrByt(S, I) := Lisp2Char car P;
	    P := cdr P >>;
	return MkSTR S;
    end else NonPairError(P, 'List2String);

syslsp procedure String2List S;		%. Make list with ASCII values in S
    if StringP S then begin scalar L, N;
	L := NIL;
	N := StrLen StrInf S;
	for I := N step -1 until 0 do
	    L := MkINT StrByt(StrInf S, I) . L;	% strip S each time in case GC
	return L;
    end else NonStringError(S, 'String2List);

syslsp procedure List2Vector L;			%. convert list to vector
    if PairP L or NULL L then begin scalar V, N;% this function is used by READ
	N := IntInf Length L - 1;
	V := GtVECT N;
	for I := 0 step 1 until N do
	<<  VecItm(V, I) := car L;
	    L := cdr L >>;
	return MkVEC V;
    end else NonPairError(L, 'List2Vector);

syslsp procedure Vector2List V;		%. Convert vector to list
    if VectorP V then begin scalar L, N;
	L := NIL;
	N := VecLen VecInf V;
	for I := N step -1 until 0 do
	    L := VecItm(VecInf V, I) . L;	% strip V each time in case GC
	return L;
    end else NonVectorError(V, 'Vector2List);

off SysLisp;

END;