mirror of
https://github.com/PDP-10/its.git
synced 2026-05-03 06:39:17 +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
187
src/maxsrc/synex.10
Normal file
187
src/maxsrc/synex.10
Normal file
@@ -0,0 +1,187 @@
|
||||
;;;;;;;;;;;;;;;;;;; -*- Mode: Lisp; Package: Macsyma -*- ;;;;;;;;;;;;;;;;;;;
|
||||
;;; (c) Copyright 1980 Massachusetts Institute of Technology ;;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(macsyma-module synex)
|
||||
|
||||
(LOAD-MACSYMA-MACROS MRGMAC)
|
||||
|
||||
(DECLARE (GENPREFIX SYN)
|
||||
(SPECIAL ST1 STRING MOPL $PROPS)
|
||||
(*EXPR LBP RBP NFORMAT MEVAL MEVAL1 GETOP ADD2LNC REMCHK ASSOL
|
||||
FULLSTRIP1 STRING* DISPLA WNA-ERR GETOPR REMPROPCHK
|
||||
$VERBIFY $NOUNIFY $LISTP))
|
||||
|
||||
; If an appropriate wrng-no-args handler were set up in maclisp, this
|
||||
; stuff could be written like this:
|
||||
; (declare (setq defun&-check-args t))
|
||||
; (DEFMFUN $prefix (operator &optional (rbp 180.) (rpos '$any) (lpos '$any))
|
||||
; (or (fixp rbp) (bp-err rbp))
|
||||
; (if (eq '& (getchar operator 1))
|
||||
; (setq operator (define-symbol operator)))
|
||||
; (define-prefix operator rbp rpos lpos))
|
||||
|
||||
(DEFMFUN $PREFIX N
|
||||
"Sets up a prefix operator, takes a bunch of optional arguments."
|
||||
(IF (> N 4) (WNA-ERR '$PREFIX))
|
||||
(DEFINE-PREFIX
|
||||
(COND ((< N 1) (WNA-ERR '$PREFIX))
|
||||
((EQ '& (GETCHAR (ARG 1) 1)) (DEFINE-SYMBOL (ARG 1)))
|
||||
(T (ARG 1)))
|
||||
(COND ((< N 2) 180.) ((FIXP (ARG 2)) (ARG 2)) (T (BP-ERR (ARG 2))))
|
||||
(COND ((< N 3) '$ANY) (T (ARG 3)))
|
||||
(COND ((< N 4) '$ANY) (T (ARG 4)))))
|
||||
|
||||
(DEFUN DEFINE-PREFIX (OP RBP RPOS POS)
|
||||
(PROG (NOUN)
|
||||
(SETQ NOUN ($NOUNIFY OP))
|
||||
(OP-SETUP OP)
|
||||
(PUT OP RBP 'RBP) (PUT NOUN RBP 'RBP)
|
||||
(PUT OP RPOS 'RPOS) (PUT OP POS 'POS)
|
||||
(PUT OP 'PARSE-PREFIX 'NUD)
|
||||
(PUT OP 'MSIZE-PREFIX 'GRIND)
|
||||
(PUT OP 'DIMENSION-PREFIX 'DIMENSION)
|
||||
(PUT NOUN 'DIMENSION-PREFIX 'DIMENSION)
|
||||
(PUT OP (NCONC (CDR (EXPLODEN OP)) '(#\SP)) 'DISSYM)
|
||||
(PUT NOUN (NCONC (CDR (EXPLODEN OP)) '(#\SP)) 'DISSYM)
|
||||
(RETURN (GETOPR OP))))
|
||||
|
||||
|
||||
(DEFMFUN $POSTFIX N
|
||||
(IF (> N 4) (WNA-ERR '$POSTFIX))
|
||||
(DEFINE-POSTFIX
|
||||
(COND ((< N 1) (WNA-ERR '$POSTFIX))
|
||||
((EQ '& (GETCHAR (ARG 1) 1)) (DEFINE-SYMBOL (ARG 1)))
|
||||
(T (ARG 1)))
|
||||
(COND ((< N 2) 180.) ((FIXP (ARG 2)) (ARG 2)) (T (BP-ERR (ARG 2))))
|
||||
(COND ((< N 3) '$ANY) (T (ARG 3)))
|
||||
(COND ((< N 4) '$ANY) (T (ARG 4)))))
|
||||
|
||||
(DEFUN DEFINE-POSTFIX (OP LBP LPOS POS)
|
||||
(PROG (NOUN)
|
||||
(SETQ NOUN ($NOUNIFY OP))
|
||||
(OP-SETUP OP)
|
||||
(PUT OP LBP 'LBP) (PUT NOUN LBP 'LBP)
|
||||
(PUT OP LPOS 'LPOS) (PUT OP POS 'POS)
|
||||
(PUT OP 'PARSE-POSTFIX 'LED)
|
||||
(PUT OP 'MSIZE-POSTFIX 'GRIND)
|
||||
(PUT OP 'DIMENSION-POSTFIX 'DIMENSION)
|
||||
(PUT NOUN 'DIMENSION-POSTFIX 'DIMENION)
|
||||
(PUT OP (CONS #\SP (CDR (EXPLODEN OP))) 'DISSYM)
|
||||
(PUT NOUN (CONS #\SP (CDR (EXPLODEN OP))) 'DISSYM)
|
||||
(RETURN (GETOPR OP))))
|
||||
|
||||
(DEFMFUN $INFIX N
|
||||
(IF (> N 6) (WNA-ERR '$INFIX))
|
||||
(DEFINE-INFIX
|
||||
(COND ((< N 1) (WNA-ERR '$INFIX))
|
||||
((EQ '& (GETCHAR (ARG 1) 1)) (DEFINE-SYMBOL (ARG 1)))
|
||||
(T (ARG 1)))
|
||||
(COND ((< N 2) 180.) ((FIXP (ARG 2)) (ARG 2)) (T (BP-ERR (ARG 2))))
|
||||
(COND ((< N 3) 180.) ((FIXP (ARG 3)) (ARG 3)) (T (BP-ERR (ARG 3))))
|
||||
(COND ((< N 4) '$ANY) (T (ARG 4)))
|
||||
(COND ((< N 5) '$ANY) (T (ARG 5)))
|
||||
(COND ((< N 6) '$ANY) (T (ARG 6)))))
|
||||
|
||||
(DEFUN DEFINE-INFIX (OP LBP RBP LPOS RPOS POS)
|
||||
(PROG (NOUN)
|
||||
(SETQ NOUN ($NOUNIFY OP))
|
||||
(OP-SETUP OP)
|
||||
(PUT OP LBP 'LBP) (PUT OP RBP 'RBP)
|
||||
(PUT OP LPOS 'LPOS) (PUT OP RPOS 'RPOS) (PUT OP POS 'POS)
|
||||
(PUT NOUN LBP 'LBP) (PUT NOUN RBP 'RBP)
|
||||
(PUT OP 'PARSE-INFIX 'LED)
|
||||
(PUT OP 'MSIZE-INFIX 'GRIND)
|
||||
(PUT OP 'DIMENSION-INFIX 'DIMENSION)
|
||||
(PUT NOUN 'DIMENSION-INFIX 'DIMENSION)
|
||||
(PUT OP (APPEND '(#\SP) (CDR (EXPLODEN OP)) '(#\SP)) 'DISSYM)
|
||||
(PUT NOUN (APPEND '(#\SP) (CDR (EXPLODEN OP)) '(#\SP)) 'DISSYM)
|
||||
(RETURN (GETOPR OP))))
|
||||
|
||||
(DEFMFUN $NARY N
|
||||
(IF (> N 4) (WNA-ERR '$NARY))
|
||||
(DEFINE-NARY
|
||||
(COND ((< N 1) (WNA-ERR '$INFIX))
|
||||
((EQ '& (GETCHAR (ARG 1) 1)) (DEFINE-SYMBOL (ARG 1)))
|
||||
(T (ARG 1)))
|
||||
(COND ((< N 2) 180.) ((FIXP (ARG 2)) (ARG 2)) (T (BP-ERR (ARG 2))))
|
||||
(COND ((< N 3) '$ANY) (T (ARG 3)))
|
||||
(COND ((< N 4) '$ANY) (T (ARG 4)))))
|
||||
|
||||
(DEFUN DEFINE-NARY (OP BP ARGPOS POS)
|
||||
(PROG (NOUN)
|
||||
(SETQ NOUN ($NOUNIFY OP))
|
||||
(OP-SETUP OP)
|
||||
(PUT OP BP 'LBP) (PUT OP BP 'RBP)
|
||||
(PUT OP ARGPOS 'LPOS) (PUT OP POS 'POS)
|
||||
(PUT NOUN BP 'LBP) (PUT NOUN BP 'RBP)
|
||||
(PUT OP 'PARSE-NARY 'LED)
|
||||
(PUT OP 'MSIZE-NARY 'GRIND)
|
||||
(PUT OP 'DIMENSION-NARY 'DIMENSION)
|
||||
(PUT NOUN 'DIMENSION-NARY 'DIMENSION)
|
||||
(PUT OP (APPEND '(#\SP) (CDR (EXPLODEN OP)) '(#\SP)) 'DISSYM)
|
||||
(PUT NOUN (APPEND '(#\SP) (CDR (EXPLODEN OP)) '(#\SP)) 'DISSYM)
|
||||
(RETURN (GETOPR OP))))
|
||||
|
||||
(DEFMFUN $MATCHFIX N
|
||||
(IF (> N 4) (WNA-ERR '$MATCHFIX))
|
||||
(DEFINE-MATCHFIX
|
||||
(COND ((< N 1) (WNA-ERR '$MATCHFIX))
|
||||
((EQ '& (GETCHAR (ARG 1) 1)) (DEFINE-SYMBOL (ARG 1)))
|
||||
(T (ARG 1)))
|
||||
(COND ((< N 2) (WNA-ERR '$MATCHFIX))
|
||||
((EQ '& (GETCHAR (ARG 2) 1)) (DEFINE-SYMBOL (ARG 2)))
|
||||
(T (ARG 2)))
|
||||
(COND ((< N 3) '$ANY) (T (ARG 3)))
|
||||
(COND ((< N 4) '$ANY) (T (ARG 4)))))
|
||||
|
||||
(DEFUN DEFINE-MATCHFIX (OP MATCH ARGPOS POS)
|
||||
(PROG (NOUN)
|
||||
(PUT OP MATCH 'MATCH)
|
||||
(SETQ NOUN ($NOUNIFY OP))
|
||||
(OP-SETUP OP) (OP-SETUP MATCH)
|
||||
(PUT OP ARGPOS 'LPOS) (PUT OP POS 'POS)
|
||||
(PUT MATCH 5. 'LBP)
|
||||
(PUT OP 'PARSE-MATCHFIX 'NUD)
|
||||
(PUT OP 'MSIZE-MATCHFIX 'GRIND)
|
||||
(PUT OP 'DIMENSION-MATCH 'DIMENSION)
|
||||
(PUT NOUN 'DIMENSION-MATCH 'DIMENSION)
|
||||
(PUT OP (CONS (CDR (EXPLODEN OP)) (CDR (EXPLODEN MATCH))) 'DISSYM)
|
||||
(PUT NOUN (CONS (CDR (EXPLODEN OP)) (CDR (EXPLODEN MATCH))) 'DISSYM)
|
||||
(RETURN (GETOPR OP))))
|
||||
|
||||
(DEFMFUN $NOFIX N
|
||||
(IF (> N 2) (WNA-ERR '$NOFIX))
|
||||
(DEFINE-NOFIX
|
||||
(COND ((< N 1) (WNA-ERR '$NOFIX))
|
||||
((EQ '& (GETCHAR (ARG 1) 1)) (DEFINE-SYMBOL (ARG 1)))
|
||||
(T (ARG 1)))
|
||||
(COND ((< N 2) '$ANY) (T (ARG 2)))))
|
||||
|
||||
(DEFUN DEFINE-NOFIX (OP POS)
|
||||
(PROG (NOUN)
|
||||
(SETQ NOUN ($NOUNIFY OP))
|
||||
(OP-SETUP OP)
|
||||
(PUT OP POS 'POS)
|
||||
(PUT OP 'PARSE-NOFIX 'NUD)
|
||||
(PUT OP 'MSIZE-NOFIX 'GRIND)
|
||||
(PUT OP 'DIMENSION-NOFIX 'DIMENSION)
|
||||
(PUT NOUN 'DIMENSION-NOFIX 'DIMENSION)
|
||||
(PUT OP (CDR (EXPLODEN OP)) 'DISSYM)
|
||||
(PUT NOUN (CDR (EXPLODEN OP)) 'DISSYM)
|
||||
(RETURN (GETOPR OP))))
|
||||
|
||||
(DEFUN OP-SETUP (OP)
|
||||
(PROG (DUMMY)
|
||||
(SETQ DUMMY (OR (GET OP 'OP) (IMPLODE (CONS '& (STRING* OP)))))
|
||||
(PUT OP DUMMY 'OP)
|
||||
(PUT DUMMY OP 'OPR)
|
||||
(IF (AND (OPERATORP1 OP) (NOT (MEMQ DUMMY (CDR $PROPS))))
|
||||
(SETQ MOPL (CONS DUMMY MOPL)))
|
||||
(ADD2LNC DUMMY $PROPS)))
|
||||
|
||||
(DEFUN BP-ERR (X)
|
||||
(MERROR "Non-integer given as binding power: ~M" X))
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user