mirror of
https://github.com/PDP-10/its.git
synced 2026-01-17 08:43:21 +00:00
Resolves #284. Commented out uses of time-origin in maxtul; mcldmp (init) until we can figure out why it gives arithmetic overflows under the emulators. Updated the expect script statements in build_macsyma_portion to not attempt to match expected strings, but simply sleep for some time since in some cases the matching appears not to work.
63 lines
2.2 KiB
Common Lisp
63 lines
2.2 KiB
Common Lisp
;;;;;;;;;;;;;;;;;;; -*- Mode: Lisp; Package: Macsyma -*- ;;;;;;;;;;;;;;;;;;;
|
|
;;; (c) Copyright 1980 Massachusetts Institute of Technology ;;;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(macsyma-module trhook)
|
|
|
|
|
|
(LOAD-MACSYMA-MACROS PROCS)
|
|
|
|
(defprop trhook /5 version)
|
|
|
|
;;; This function needs to be in its own file.
|
|
;;; It forms a vital low-level part of the autoloading system of
|
|
;;; the macsyma->lisp translator. However, it is not itself
|
|
;;; a TRANSL-MODULE, since it is needed to implement TRANSL-MODULE.
|
|
;;; Various parts of the translator may be loaded, and in various
|
|
;;; orders, depending on what entry points are called.
|
|
;;; The entry points are in various files.
|
|
|
|
;;; Note: It wasn't obvious how to do this the first time
|
|
;;; - GJC.
|
|
|
|
;;; Autloadable Translation properties. Needed for small address space systems
|
|
;;; only. Figure out what to do for Twenex. We really want a facility like
|
|
;;; this for all of Macsyma, where MDEFCOM is used to define a Macsyma
|
|
;;; user-level command, and an autoload property is automatically generated for
|
|
;;; the entrypoint. -cwh
|
|
;;; No kidding. DEF%TRFUN and DEF%TR does this for the TRANSL package. -gjc
|
|
|
|
#+PDP10
|
|
(DEF-PROCEDURE-PROPERTY
|
|
AUTOLOAD-TRANSLATE ;; The trampoline for autoloading during translation.
|
|
(LAMBDA (FORM)
|
|
(REMPROP (CAAR FORM) 'TRANSLATE)
|
|
(LET ((FILENAME (GET (CAAR FORM) 'AUTOLOAD-TRANSLATE)))
|
|
(COND (FILENAME
|
|
(LOAD-AND-TELL FILENAME))
|
|
((GET (CAAR FORM) 'AUTOLOAD)
|
|
(LOAD-FUNCTION (CAAR FORM) T))))
|
|
(TRANSLATE FORM))
|
|
SUBR)
|
|
|
|
(DEFUN MAP1-PUT-IF-NIL (LIST-OF-SYMBOLS PROP NAME)
|
|
(DO ((SYM))
|
|
((NULL LIST-OF-SYMBOLS) PROP)
|
|
(SETQ SYM (POP LIST-OF-SYMBOLS))
|
|
(IF (NOT (GET SYM NAME))
|
|
(PUTPROP SYM PROP NAME))))
|
|
|
|
(defun put-map (l p &optional (it t))
|
|
(do () ((null l))
|
|
(let ((sym (pop l)))
|
|
(if (symbolp sym)
|
|
(setf (get sym p) it)))))
|
|
|
|
(defun special fexpr (l) (put-map l 'special))
|
|
(defun *lexpr fexpr (l) (put-map l '*lexpr))
|
|
(defun *expr fexpr (l) (put-map l '*expr))
|
|
(defun *fexpr fexpr (l) (put-map l '*fexpr))
|
|
(defun fixnum fexpr (l) (put-map l 'mode '$fixnum))
|
|
(defun flonum fexpr (l) (put-map l 'mode '$float))
|
|
|