Artifact 559924f839cb6e62653d4e9418f21a0c950c14e456f3aa35f1d75d956c06fcb1:

• File psl-1983/3-1/util/pslcomp-main.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: 3477) [annotate] [blame] [check-ins using] [more...]

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% PSLCOMP-MAIN.SL
% 
% Author:      Alan Snyder
%              Hewlett-Packard/CRC
% Date:        27 September 1982
% Revised:     8 December 1982
%
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% This file redefines the start-up routine for PSLCOMP to read and interpret
% the program command string as a list of source files to be compiled.

% Edit by Cris Perdue,  8 Apr 1983 1401-PST
% Compile-files now does exitlisp rather than quit.
%  EvIn is only given a definition if not already defined.
%  Syntax is assumed to be LISP if given a crazy file extension.
% Edit by Cris Perdue,  5 Apr 1983 1421-PST
% Changed to use get-command-args rather than get-command-string
%  and parse-command-string.
%  Uses EVIN to read the file, thus compiles any type of file.
%  If no extension specified, tries "sl", "build", and "red" extensions.
%  Defines EVIN to load RLISP if needed.  This also gets around the
%  problem of starting up in the RLISP top level with RLISP
%  loaded.
%  Now uses ErrSet rather than ErrorSet.
% 8-Dec-82 Alan Snyder
%   Changed use of DSKIN (now an EXPR).

(CompileTime (load common pathnames))
(imports '(pathnamex get-command-args compiler))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(fluid '(*usermode *redefmsg CurrentReadMacroIndicator* CurrentScanTable*))
(fluid '(*quiet_faslout *WritingFASLFile))

(cond ((funboundp 'original-main)
       (copyd 'original-main 'main)))

(de main ()
  (let ((CurrentReadMacroIndicator* 'LispReadMacro) % Crock!
	(CurrentScanTable* LispScanTable*)
	(c-list (get-command-args))
	(*usermode nil)
	(*redefmsg nil))
       (compile-files c-list)
       (copyd 'main 'original-main)
       )
  (original-main)
  )

(de pslcomp ()	% Not in use. /csp
  (let ((*usermode nil)
	(*redefmsg nil))
    (compile-files (get-command-args))))

(if (funboundp 'evin)
  (de evin (x)
    (load rlisp)
    (eval (list 'in x))))	% Hack. /csp

(de compile-files (c-list)
  (cond ((null c-list)
	 (PrintF "Portable Standard Lisp Compiler%n")
	 (PrintF "Usage: PSLCOMP source-file ...%n")
	 )
	(t
	 (for (in fn c-list)
	      (do (attempt-to-compile-file fn))
	      )
         (exitlisp)
	 )))

(de attempt-to-compile-file (fn)
  (let* ((*break NIL)
	 (result (ErrSet (compile-file fn) T))
	 )
    (cond ((FixP result)
	   (if *WritingFASLFile (faslend))
	   (printf "%n ***** Error during compilation of %w.%n" fn)
	   ))
    ))

(de compile-file (fn)
  (let* ((pathname (pathname fn))
	 (source-names
	  (cond ((pathname-type pathname)
		 (list (namestring pathname)))
		(t (for (in ext '("build" "sl" "red"))
			(collect
			 (namestring (pathname-set-default-type 
				      pathname
				      ext)))))))
	 (binary-fn (namestring (pathname-set-type fn "b")))
	 (*quiet_faslout T)
	 (type NIL)
	 )
    (for (in source-fn source-names)
	 (do
	  (cond
	   ((FileP source-fn)
	    (printf "%n----- Compiling %w%n" source-fn)
	    (faslout (namestring (pathname-without-type binary-fn)))
	    (setq type (pathname-type (pathname source-fn)))
	    (funcall (cond ((string-equal type "sl") 'dskin)
			   ((string-equal type "build") 'evin)
			   ((string-equal type "red") 'evin)
			   (t 'dskin))
		     source-fn)
	    (faslend)
	    (printf "%nDone compiling %w%n%n" source-fn)
	    (return t)
	    )))
	 (finally
	    (printf "Unable to find source file for: %w%n" fn)))))