Artifact c42a3aa0bae94354a666e598a6e708b007c15b24d4a9d681a177716d87e49aaa:

• File psl-1983/3-1/util/20/homedir.sl — 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: 2208) [annotate] [blame] [check-ins using] [more...]

%
% HOMEDIR.SL - USER-HOMEDIR-STRING function for Tops-20
% 
% Author:      Eric Benson
%              Symbolic Computation Group
%              Computer Science Dept.
%              University of Utah
% Date:        21 September 1982
% Copyright (c) 1982 University of Utah
%
% 6 June 1983 Mark R. Swanson
% Changes for extended addressing.

(compiletime (progn
 (load monsym syslisp)
 (put 'get-user-number 'opencode '((gjinf)))
 (flag '(user-homedir-string-aux get-dir-string)
       'internalfunction)))

% Returns a string which is the init file for program-name.
% Optional HOST is not supported.
(de init-file-string (program-name)
  (concat (user-homedir-string) (concat program-name ".INIT")))

% Returns a string which is the users home directory name.
% Optional HOST is not supported.
(lap '((*entry user-homedir-string expr 0)
       (xmovei (reg 1) (indexed (reg st) 1))	% Pointer into the stack
       (*alloc 20)				% allocate space
       (*call user-homedir-string-aux)	% call the real function
       (*exit 20)))				% deallocate and return

(de user-homedir-string-aux (p)
  (concat "PS:<" (mkstr (get-dir-string p (get-user-number)))))

(lap '((*entry get-dir-string expr 2)
       (*move (reg 1) (reg 5))			% save original addr in ac5
%      (tlz (reg 1) 8#770000)                   % mask out old TAG (which
                                                % isn't there)
       (tlo (reg 1) 8#660000)                   % make it a global byte
						% pointer which will start
						% with next word
       (*move (reg 1) (reg 3))			% save it in ac3
       (dirst)
         (erjmp cant-get-dir)
       (movei (reg 4) 62)			% put a closing > on it
       (idpb (reg 4) (reg 1))
       (setz (reg 4) 0)				% put a null char on the end
       (idpb (reg 4) (reg 1))
       (seto (reg 4) 0)				% initialize length to -1
string-length-loop
       (ildb (reg 2) (reg 3))
       (jumpe (reg 2) done-computing-length)
       (aoja (reg 4) string-length-loop)
done-computing-length
       (movem (reg 4) (indexed (reg 5) 0))	% put len in string header
       (*move (reg 5) (reg 1))			% return original pointer
       (*exit 0)
cant-get-dir
       (*move (reg 1) '"UNKNOWN>")
       (*exit 0)))