mirror of
https://github.com/PDP-10/its.git
synced 2026-05-02 06:25:59 +00:00
Added files to support building and running Macsyma.
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.
This commit is contained in:
Eric Swenson
267
src/transl/trmode.74
Normal file
267
src/transl/trmode.74
Normal file
@@ -0,0 +1,267 @@
|
||||
;;; -*- mode: lisp; package: macsyma -*-
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; gjc: 6:27pm sunday, 20 july 1980
|
||||
;;; (c) copyright 1979 massachusetts institute of technology ;;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
||||
|
||||
(macsyma-module trmode)
|
||||
|
||||
|
||||
(transl-module trmode)
|
||||
(defmvar $mode_checkp t "if true, modedeclare checks the modes of bound variables.")
|
||||
(defmvar $mode_check_warnp t "if true, mode errors are described.")
|
||||
(defmvar $mode_check_errorp nil "if true, modedeclare calls error.")
|
||||
|
||||
(defun mseemingly-unbound (x)
|
||||
(or (not (boundp x)) (eq (symeval x) x)))
|
||||
|
||||
(DEFMFUN CHEKVALUE (V MODE
|
||||
&optional
|
||||
(val (meval1 v) val-givenp))
|
||||
(COND ((or val-givenp (not (eq v val)))
|
||||
; hack because macsyma PROG binds variable
|
||||
; to itself.
|
||||
(let ((CHECKER (ASSQ MODE '(($FLOAT . FLOATP)
|
||||
($FIXNUM . FIXP)
|
||||
($NUMBER . NUMBERP)
|
||||
($LIST . $LISTP)
|
||||
($BOOLEAN . (LAMBDA (U)
|
||||
(MEMQ U '(T NIL))))))))
|
||||
(COND ((AND CHECKER (NOT (FUNCALL (CDR CHECKER) VAL)))
|
||||
(SIGNAL-MODE-ERROR V MODE VAL)))))))
|
||||
|
||||
(defmfun assign-mode-check (var value)
|
||||
(let ((mode (get var 'mode))
|
||||
(user-level ($get var '$value_check)))
|
||||
(if mode
|
||||
(let (($mode_check_warnp t)
|
||||
($mode_check_errorp t))
|
||||
(chekvalue var mode value)))
|
||||
(if user-level
|
||||
(mcall user-level value)))
|
||||
value)
|
||||
|
||||
(DEFTRVAR DEFINED_VARIABLES ())
|
||||
|
||||
(DEFTRVAR $DEFINE_VARIABLE ())
|
||||
|
||||
(DEF%TR $DEFINE_VARIABLE (FORM) ;;VAR INIT MODE.
|
||||
(COND ((> (LENGTH FORM) 3)
|
||||
(LET (((VAR VAL MODE) (CDR FORM)))
|
||||
(LET ((SPEC-FORM `(($DECLARE) ,VAR $SPECIAL))
|
||||
(MODE-FORM `(($MODEDECLARE) ,VAR ,MODE)))
|
||||
(translate spec-form)
|
||||
(translate mode-form)
|
||||
(PUSH-PRE-TRANSL-FORM
|
||||
;; POSSIBLE OVERKILL HERE
|
||||
`(declare (special ,VAR)))
|
||||
(PUSH VAR DEFINED_VARIABLES)
|
||||
;; Get rid of previous definitions put on by
|
||||
;; the translator.
|
||||
(DO ((L *PRE-TRANSL-FORMS* (CDR L)))
|
||||
((NULL L))
|
||||
;; REMOVE SOME OVERKILL
|
||||
(COND ((AND (EQ (CAAR L) 'DEF-MTRVAR)
|
||||
(EQ (CADAR L) VAR))
|
||||
(SETQ *PRE-TRANSL-FORMS*
|
||||
(DELQ (CAR L) *PRE-TRANSL-FORMS*)))))
|
||||
(if (not (eq mode '$any))
|
||||
;; so that the rest of the translation gronks this.
|
||||
(putprop var 'assign-mode-check 'assign))
|
||||
`($any . (progn 'compile
|
||||
(meval* ',mode-form)
|
||||
(meval* ',spec-form)
|
||||
,(if (not (eq mode '$any))
|
||||
`(defprop ,var
|
||||
assign-mode-check
|
||||
assign))
|
||||
(def-mtrvar ,(cadr form)
|
||||
,(dtranslate (caddr form))
|
||||
)))
|
||||
)))
|
||||
(t
|
||||
(TR-TELL "Wrong number of arguments" form)
|
||||
nil)))
|
||||
|
||||
#-LISPM
|
||||
;; Not needed on LISPM because the MACRO definition is in effect.
|
||||
;; For NIL we must do some fexpr abstraction anyway.
|
||||
(defun def-mtrvar fexpr (l)
|
||||
(LET (((V A . IGNORE-CRUFTY) L))
|
||||
;; priority of setting is obsolete, but must be around for
|
||||
;; old translated files. i.e. TRMODE version < 69.
|
||||
(if (mseemingly-unbound v)
|
||||
(set v (eval a))
|
||||
(SYMEVAL v))))
|
||||
|
||||
;; the priority fails when a DEF-MTRVAR is done, then the user
|
||||
;; sets the variable, because the set-priority stays the same.
|
||||
;; This causes some Define_Variable's to over-ride the user setting,
|
||||
;; but only in the case of re-loading, what we were worried about
|
||||
;; is pre-setting of variables of autoloading files.
|
||||
|
||||
(defmspec $define_variable (l) (setq l (cdr l))
|
||||
(or (> (length l) 2)
|
||||
(merror "Wrong number of arguments to DEFINE_VARIABLE"))
|
||||
(or (symbolp (car l))
|
||||
(merror "First arg to DEFINE_VARIABLE not a SYMBOL."))
|
||||
(meval `(($modedeclare) ,(car l) ,(caddr l)))
|
||||
(meval `(($declare) ,(car l) $special))
|
||||
(if (not (eq (caddr l) '$any))
|
||||
(putprop (car l) 'assign-mode-check 'assign))
|
||||
(if (mseemingly-unbound (car l))
|
||||
(meval `((msetq) ,(car l) ,(cadr l)))
|
||||
(meval (car l))))
|
||||
|
||||
|
||||
(DEFMSPEC $MODE_IDENTITY (L) (SETQ L (CDR L))
|
||||
(OR (= (LENGTH L) 2) (MERROR "MODE_IDENTITY takes 2 arguments."))
|
||||
(LET ((V (MEVAL (CADR L))))
|
||||
(CHEKVALUE (CADR L) (IR (CAR L)) V)
|
||||
V))
|
||||
|
||||
(DEF%TR $MODE_IDENTITY (FORM)
|
||||
`(,(IR (CADR FORM)) . ,(DTRANSLATE (CADDR FORM))))
|
||||
|
||||
(DEF%TR $MODEDECLARE (FORM)
|
||||
(DO L (CDR FORM) (CDDR L) (NULL L) (DECLMODE (CAR L) (IR (CADR L)) T)))
|
||||
|
||||
(DEFMFUN ASS-EQ-REF N
|
||||
(LET ((VAL (ASSQ (ARG 2) (ARG 1))))
|
||||
(IF VAL (CDR VAL)
|
||||
(IF (= N 3) (ARG 3) NIL))))
|
||||
|
||||
(DEFMFUN ASS-EQ-SET (VAL TABLE KEY)
|
||||
(LET ((CELL (ASSQ KEY TABLE)))
|
||||
(IF CELL (SETF (CDR CELL) VAL)
|
||||
(PUSH (CONS KEY VAL) TABLE)))
|
||||
TABLE)
|
||||
|
||||
|
||||
;;; Possible calls to MODEDECLARE.
|
||||
;;; MODEDECLARE(<oblist>,<mode>,<oblist>,<mode>,...)
|
||||
;;; where <oblist> is:
|
||||
;;; an ATOM, signifying a VARIABLE.
|
||||
;;; a LIST, giving a list of objects of <mode>
|
||||
;;;
|
||||
|
||||
(DEFMSPEC $MODEDECLARE (X) (SETQ X (CDR X))
|
||||
(IF (ODDP (LENGTH X))
|
||||
(MERROR "MODE_DECLARE takes an even number of arguments."))
|
||||
(DO ((L X (CDDR L)) (NL))
|
||||
((NULL L) (CONS '(MLIST) (NREVERSE NL)))
|
||||
(DECLMODE (CAR L) (IR (CADR L)) NIL)
|
||||
(SETQ NL (CONS (CAR L) NL))))
|
||||
|
||||
(DEFUN TR-DECLARE-VARMODE (VARIABLE MODE)
|
||||
(DECLVALUE VARIABLE (IR MODE) T))
|
||||
|
||||
;;; If TRFLAG is TRUE, we are in the translator, if NIL, we are in the
|
||||
;;; interpreter.
|
||||
(DECLARE (SPECIAL TRFLAG MODE FORM))
|
||||
(DEFUN DECLMODE (FORM MODE TRFLAG)
|
||||
(COND ((ATOM FORM)
|
||||
(DECLVALUE FORM MODE TRFLAG)
|
||||
(AND (NOT TRFLAG) $MODE_CHECKP (CHEKVALUE FORM MODE)))
|
||||
((EQ 'MLIST (CAAR FORM))
|
||||
(MAPC '(LAMBDA (L)
|
||||
(DECLMODE L MODE TRFLAG))
|
||||
(CDR FORM)))
|
||||
((MEMQ 'ARRAY (CDAR FORM))
|
||||
(DECLARRAY (CAAR FORM) MODE))
|
||||
((EQ '$FUNCTION (CAAR FORM))
|
||||
(MAPC '(LAMBDA (L)
|
||||
(DECLFUN L MODE))
|
||||
(CDR FORM)))
|
||||
((MEMQ (CAAR FORM) '($FIXED_NUM_ARGS_FUNCTION
|
||||
$VARIABLE_NUM_ARGS_FUNCTION))
|
||||
(MAPC '(LAMBDA (F)
|
||||
(DECLFUN F MODE)
|
||||
(MPUTPROP F T (CAAR FORM)))
|
||||
(CDR FORM)))
|
||||
((EQ '$COMPLETEARRAY (CAAR FORM))
|
||||
(MAPC '(LAMBDA (L)
|
||||
(PUTPROP (COND ((ATOM L) L)
|
||||
(T (CAAR L)))
|
||||
MODE 'ARRAY-MODE))
|
||||
(CDR FORM)))
|
||||
((EQ '$ARRAY (CAAR FORM))
|
||||
(MAPC '(LAMBDA (L) (MPUTPROP L MODE 'ARRAY-MODE)) (CDR FORM)))
|
||||
((EQ '$ARRAYFUN (CAAR FORM))
|
||||
(MAPC '(LAMBDA (L) (MPUTPROP L MODE 'ARRAYFUN-MODE)) (CDR FORM)))
|
||||
(T
|
||||
(DECLFUN (CAAR FORM) MODE))))
|
||||
(DECLARE (UNSPECIAL TRFLAG MODE FORM))
|
||||
|
||||
(DEFTRFUN DECLVALUE (V MODE TRFLAG)
|
||||
(IF TRFLAG (SETQ V (TEVAL V)))
|
||||
(ADD2LNC V $PROPS)
|
||||
(PUTPROP V MODE 'MODE))
|
||||
|
||||
|
||||
(DEFUN SIGNAL-MODE-ERROR (OBJECT MODE VALUE)
|
||||
(COND ((AND $MODE_CHECK_WARNP
|
||||
(NOT $MODE_CHECK_ERRORP))
|
||||
(MTELL "Warning: ~:M was declared mode ~:M, has value: ~M"
|
||||
OBJECT MODE VALUE))
|
||||
($MODE_CHECK_ERRORP
|
||||
(MERROR "Error: ~:M was declared mode ~:M, has value: ~M"
|
||||
OBJECT MODE VALUE))))
|
||||
|
||||
(DEFUN PUT-MODE (NAME MODE TYPE)
|
||||
(IF (GET NAME 'TBIND)
|
||||
(SETF (GET NAME 'VAL-MODES)
|
||||
(ASS-EQ-SET MODE (GET NAME 'VAL-MODES) TYPE))
|
||||
(SETF (GET NAME TYPE) MODE)))
|
||||
|
||||
(DEFUN DECLARRAY (AR MODE)
|
||||
(PUT-MODE AR MODE 'ARRAY-MODE))
|
||||
|
||||
(DEFUN DECLFUN (F MODE) (PUT-MODE F MODE 'FUNCTION-MODE))
|
||||
|
||||
;;; 1/2 is not $RATIONAL. bad name. it means CRE form.
|
||||
|
||||
(DEFUN IR (X)
|
||||
(CASEQ X
|
||||
(($FLOAT $REAL $FLOATP $FLONUM $FLOATNUM) '$FLOAT)
|
||||
(($FIXP $FIXNUM) '$FIXNUM)
|
||||
(($RATIONAL $RAT) '$RATIONAL)
|
||||
(($NUMBER $BIGNUM $BIG) '$NUMBER)
|
||||
(($BOOLEAN $BOOL) '$BOOLEAN)
|
||||
(($LIST $LISTP) '$LIST)
|
||||
(($ANY $NONE $ANY_CHECK) '$ANY)
|
||||
(T (UDM-ERR X) X)))
|
||||
|
||||
(DEFUN UDM-ERR (MODE)
|
||||
(MTELL "Warning: ~:M is not a known mode declaration ~
|
||||
maybe you want ~:M mode.~%"
|
||||
MODE
|
||||
(CASEQ MODE
|
||||
(($INTEGER $INTEGERP) '$FIXNUM)
|
||||
(($COMPLEX) "&to ask about this")
|
||||
(($FUCKED $SHITTY) "&to watch your language")
|
||||
(T "&to see the documentation on"))))
|
||||
|
||||
|
||||
(DEFMFUN FLUIDIZE (VARIABLE)
|
||||
(MAPC #'(LAMBDA (V) (OR (BOUNDP V) (SET V ())))
|
||||
;; what a sorry crock to have all these switches.
|
||||
'(*IN-COMPILE*
|
||||
*IN-COMPFILE*
|
||||
*IN-TRANSLATE*
|
||||
*IN-TRANSLATE-FILE*))
|
||||
|
||||
(PUTPROP VARIABLE T 'SPECIAL)
|
||||
(IF (AND $TRANSCOMPILE
|
||||
(OR *IN-COMPILE*
|
||||
*IN-COMPFILE*
|
||||
*IN-TRANSLATE*
|
||||
*IN-TRANSLATE-FILE*))
|
||||
(ADDL VARIABLE SPECIALS)))
|
||||
|
||||
(DEFMSPEC $BIND_DURING_TRANSLATION (FORM)
|
||||
(MEVALN (CDDR FORM)))
|
||||
|
||||
|
||||
Reference in New Issue
Block a user