mirror of
https://github.com/PDP-10/its.git
synced 2026-01-21 18:16:07 +00:00
85994ed770
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.
89 lines
2.6 KiB
Common Lisp
89 lines
2.6 KiB
Common Lisp
;;;;;;;;;;;;;;;;;;; -*- Mode: Lisp; Package: Macsyma -*- ;;;;;;;;;;;;;;;;;;;
|
|
;;; (c) Copyright 1980 Massachusetts Institute of Technology ;;;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(macsyma-module trdump)
|
|
|
|
|
|
(DEFVAR TRF-START-HOOK NIL)
|
|
|
|
(defun umail (JUNK &aux stream winp)
|
|
(unwind-protect
|
|
(progn
|
|
(SETQ STREAM (OPEN "DSK:.MAIL.;MAIL _TEMP" 'OUT))
|
|
(MFORMAT STREAM
|
|
"FROM-PROGRAM:~A~
|
|
~%FROM-XUNAME:~A~
|
|
~%FROM-UNAME:~A~
|
|
~%RCPT:([DSK:GJC;TM USAGE])~
|
|
~%TEXT;-1~%~S"
|
|
(STATUS SUBSYS)
|
|
(STATUS XUNAME)
|
|
(STATUS UNAME)
|
|
JUNK)
|
|
(SETQ WINP T))
|
|
(IF WINP
|
|
(RENAMEF STREAM "DSK:.MAIL.;MAIL >") ; actually "sends" the mail.
|
|
(IF STREAM (DELETEF STREAM)))))
|
|
|
|
(defun $trdump (v &optional (purep nil))
|
|
(let ((*pure purep)
|
|
(putprop (if purep
|
|
`(translate autoload-translate
|
|
special *expr *fexpr *lexpr
|
|
mode function-mode
|
|
,@putprop)
|
|
putprop)))
|
|
(find-function '$suspend)
|
|
(SETQ $DUMPTIME ($TIMEDATE))
|
|
(or (get 'transl-autoload 'version)
|
|
($load '|&dsk:macsym;transl autoload|))
|
|
(or (fboundp 'sprin1)
|
|
(load-and-tell (get 'sprin1 'autoload)))
|
|
(or (fboundp '$tty_INIT)
|
|
(load (get '$tty_init 'autoload)))
|
|
(mapc '(lambda (u)
|
|
(let ((file `((dsk macsym) ,u fasl)))
|
|
(or (get u 'version)
|
|
(not (probef file))
|
|
(load-and-tell file))))
|
|
transl-modules))
|
|
(meval '(($KILL) $LABELS))
|
|
($suspend (namestring `((dsk maxdmp) trdump ,v)))
|
|
($tty_init)
|
|
(SSTATUS GCTIME 0)
|
|
(MTELL-OPEN
|
|
"~%This is the Macsyma Translator version ~A~
|
|
~%in Macsyma version ~A~%"
|
|
v $version)
|
|
(let* ((filedir `((dsk ,(status udir)) * *))
|
|
(init (mergef filedir `(,(status uname) tm))))
|
|
(defaultf (mergef filedir '(foo >)))
|
|
(cond ((probef init)
|
|
($load (to-macsyma-namestring init)))
|
|
((setq init (probef (mergef filedir '(* tm))))
|
|
($load (to-macsyma-namestring init)))))
|
|
(let ((jcl (mapcar #'(lambda (u) (getcharn u 1))
|
|
(status jcl))))
|
|
(COND ((AND jcl
|
|
(SETQ JCL (do ((junks '(#^@ #^C #\CR #^_ #\LF) (cdr junks)))
|
|
((null junks) JCL)
|
|
(SETQ JCL (DELETE (CAR JUNKS) JCL))))
|
|
(DO ((L JCL (CDR L)))
|
|
((NULL L) NIL)
|
|
(IF (NOT (MEMBER (CAR L) '(#\SP #\TAB)))
|
|
(RETURN T))))
|
|
(LET ((TRF-START-HOOK
|
|
#'(LAMBDA (F)
|
|
(UMAIL `((FILENAME . ,F)))
|
|
(SETQ ^W T)
|
|
(VALRET '|:PROCED |)))
|
|
(WINP NIL)
|
|
(^W ^W)
|
|
(FILENAME (maknam (cons #/& jcl))))
|
|
(UNWIND-PROTECT
|
|
(PROGN ($translate_file FILENAME)
|
|
(SETQ WINP T))
|
|
(IF WINP (QUIT)))))
|
|
(t
|
|
(continue))))) |