mirror of
https://github.com/PDP-10/its.git
synced 2026-01-17 00:33:22 +00:00
139 lines
4.3 KiB
Common Lisp
139 lines
4.3 KiB
Common Lisp
;;-*-LISP-*-
|
|
;;
|
|
;; Temporary macsyma module definition.
|
|
;; The compiler must first load this file, or the file
|
|
;; "LIBMAX;MODULE DEF"
|
|
|
|
(HERALD MACSYMA-MODULE)
|
|
|
|
(DEFPROP MACSYMA-MODULE MACSYMA-MODULE-MACRO MACRO)
|
|
|
|
;; These should be structures rather than sets of special variables.
|
|
|
|
(DEFVAR NEEDED-MACRO-FILES)
|
|
(DEFVAR EVALUATOR-OPTIONS NIL)
|
|
(DEFVAR COMPILER-OPTIONS NIL)
|
|
(DEFVAR RUNTIME-OPTIONS NIL)
|
|
|
|
(DEFVAR NEEDED-MACRO-FILES-RUNTIME NIL)
|
|
(DEFVAR EVALUATOR-OPTIONS-RUNTIME NIL)
|
|
(DEFVAR COMPILER-OPTIONS-RUNTIME NIL)
|
|
(DEFVAR RUNTIME-OPTIONS-RUNTIME NIL)
|
|
|
|
(DEFVAR NEEDED-MACRO-FILES-MACRO NIL)
|
|
(DEFVAR EVALUATOR-OPTIONS-MACRO NIL)
|
|
(DEFVAR COMPILER-OPTIONS-MACRO NIL)
|
|
(DEFVAR RUNTIME-OPTIONS-MACRO NIL)
|
|
|
|
(DEFVAR LOADED-MACRO-FILES ()
|
|
"This is really macro files that were attempted to be loaded,
|
|
and is used by the annotater. The version property of the
|
|
macro file really tells if it is loaded.")
|
|
|
|
(OR (MEMQ 'MACSYMA-MODULE LOADED-MACRO-FILES)
|
|
(PUSH 'MACSYMA-MODULE LOADED-MACRO-FILES))
|
|
|
|
(DEFVAR LOAD-MACRO-FILE-TELL NIL)
|
|
(DEFVAR MACRO-MODULE-LOAD-STACK NIL)
|
|
|
|
(DEFUN LOAD-MACRO-FILE (NAME &OPTIONAL (FILE "DSK:LIBMAX;"))
|
|
(OR (MEMQ NAME LOADED-MACRO-FILES)
|
|
(PUSH NAME LOADED-MACRO-FILES))
|
|
(COND ((GET NAME 'VERSION)
|
|
(IF LOAD-MACRO-FILE-TELL
|
|
(FORMAT MSGFILES
|
|
"~&; ~A version ~A already loaded.~%"
|
|
NAME (GET NAME 'VERSION))))
|
|
('ELSE
|
|
(IF LOAD-MACRO-FILE-TELL
|
|
(FORMAT MSGFILES
|
|
"~&; Attempting to load ~A~%" NAME))
|
|
(IF (MEMQ NAME MACRO-MODULE-LOAD-STACK)
|
|
(IF LOAD-MACRO-FILE-TELL
|
|
(FORMAT MSGFILES
|
|
"~&; but ~A is already being loaded. ~
|
|
Therefore I will punt.~%"
|
|
NAME))
|
|
(LET ((MACRO-MODULE-LOAD-STACK
|
|
(CONS NAME MACRO-MODULE-LOAD-STACK)))
|
|
(LOAD (MERGEF FILE NAME)))))))
|
|
|
|
(DEFVAR LOAD-DCL-DATABASE T)
|
|
|
|
(DEFUN LOAD-DCL-DATABASE ()
|
|
(COND (LOAD-DCL-DATABASE
|
|
(FORMAT MSGFILES "~&; Loading declarations~%")
|
|
(LOAD-DCL-DATABASE-FILE "MAXDOC;DCL FCTNS")
|
|
(LOAD-DCL-DATABASE-FILE "MAXDOC;DCL VARS"))))
|
|
|
|
(DEFUN LOAD-DCL-DATABASE-FILE (FN)
|
|
(LET (STREAM)
|
|
(UNWIND-PROTECT
|
|
(PROGN (SETQ STREAM (OPEN FN))
|
|
(DO ((FORM))
|
|
((NULL (SETQ FORM (READ STREAM ()))))
|
|
(EVAL (CADR FORM))))
|
|
(AND STREAM (CLOSE STREAM)))))
|
|
|
|
(DEFUN MACSYMA-MODULE-MACRO (FORM)
|
|
(LET (((NAME . OPTIONS) (CDR FORM)))
|
|
(COND ((NULL OPTIONS)
|
|
(IF COMPILER-STATE (LOAD-DCL-DATABASE))
|
|
(SETQ NEEDED-MACRO-FILES NEEDED-MACRO-FILES-RUNTIME)
|
|
(SETQ EVALUATOR-OPTIONS EVALUATOR-OPTIONS-RUNTIME)
|
|
(SETQ COMPILER-OPTIONS COMPILER-OPTIONS-RUNTIME)
|
|
(SETQ RUNTIME-OPTIONS RUNTIME-OPTIONS-RUNTIME))
|
|
((MEMQ 'MACRO OPTIONS)
|
|
(SETQ NEEDED-MACRO-FILES NEEDED-MACRO-FILES-MACRO)
|
|
(SETQ EVALUATOR-OPTIONS EVALUATOR-OPTIONS-MACRO)
|
|
(SETQ COMPILER-OPTIONS COMPILER-OPTIONS-MACRO)
|
|
(SETQ RUNTIME-OPTIONS RUNTIME-OPTIONS-MACRO)
|
|
(PUSH `(PROGN 'COMPILE
|
|
(HERALD ,NAME)
|
|
(DEFVAR LOADED-MACRO-FILES NIL)
|
|
(OR (MEMQ ',NAME LOADED-MACRO-FILES)
|
|
(PUSH ',NAME LOADED-MACRO-FILES)))
|
|
RUNTIME-OPTIONS)))
|
|
(MAPCAR #'(LAMBDA (U)(APPLY #'LOAD-MACRO-FILE U))
|
|
NEEDED-MACRO-FILES)
|
|
(COND ((MEMQ COMPILER-STATE '(MAKLAP COMPILE))
|
|
(mapc #'eval compiler-options)
|
|
(ANNOTATE-UNFASL-FILE)))
|
|
(IF (NOT COMPILER-STATE)
|
|
(mapc #'eval evaluator-options))
|
|
`(progn 'COMPILE ,@runtime-options)))
|
|
|
|
(DECLARE (SPECIAL TEST-COMPILATION-P))
|
|
|
|
(DEFUN ANNOTATE-UNFASL-FILE ()
|
|
(LET ((UNFASL (IF (EQ (CAAR (NAMELIST (CAR CMSGFILES))) 'DSK)
|
|
(CAR CMSGFILES)
|
|
(CADR CMSGFILES))))
|
|
(FORMAT UNFASL "~%;; Macsyma ~:[test~;installation~] compilation by ~A.~%"
|
|
(AND (NOT (AND (BOUNDP 'TEST-COMPILATION-P)
|
|
TEST-COMPILATION-P))
|
|
(STATUS FEATURE MACSYMA-COMPLR))
|
|
(STATUS UNAME))
|
|
(FORMAT UNFASL
|
|
";; Macsyma compilation environment version ~A~%;; dumped on ~A by ~A~%"
|
|
(GET 'MCOMPILER 'VERSION)
|
|
(GET 'MCOMPILER 'DATE)
|
|
(GET 'MCOMPILER 'UNAME))
|
|
(FORMAT UNFASL ";; ~15A" "Macro files:")
|
|
(FORMAT UNFASL "~{~<~%;; ~15X~:;~A ~A~>~^, ~}~%"
|
|
(MAPCAN #'(LAMBDA (X) `(,X ,(GET X 'VERSION)))
|
|
LOADED-MACRO-FILES)
|
|
)))
|
|
|
|
|
|
(DEFUN AUTOLOAD-MACRO (NAME FILE &OPTIONAL (FUNCTION (SYMBOLCONC NAME '| MACRO|)))
|
|
(COND ((NOT (GET NAME 'MACRO))
|
|
(PUTPROP NAME FUNCTION 'MACRO)
|
|
(PUTPROP FUNCTION FILE 'AUTOLOAD))))
|
|
|
|
|
|
;; Compiler and Evaluator Options, get 'em from another file, for
|
|
;; ease of hackery!
|
|
|
|
(LOAD "DSK:LIBMAX;MODULE OPTIONS")
|