mirror of
https://github.com/PDP-10/its.git
synced 2026-03-24 01:27:33 +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.
100 lines
2.7 KiB
Common Lisp
Executable File
100 lines
2.7 KiB
Common Lisp
Executable File
;;;;;;;;;;;;;;;;;;; -*- Mode: Lisp; Package: Macsyma -*- ;;;;;;;;;;;;;;;;;;;
|
|
;;; (c) Copyright 1980 Massachusetts Institute of Technology ;;;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(macsyma-module ratmac macro)
|
|
|
|
;; Macros for manipulating rational functions.
|
|
|
|
(DEFMACRO PCOEFP (E) `(ATOM ,E))
|
|
|
|
#-LISPM
|
|
(DEFMACRO PZEROP (X) `(SIGNP E ,X)) ;TRUE FOR 0 OR 0.0
|
|
#+LISPM
|
|
(DEFMACRO PZEROP (X) `(LET ((.X. ,X)) (AND (NUMBERP .X.) (ZEROP .X.))))
|
|
|
|
(DEFMACRO PZERO () 0)
|
|
|
|
(DEFMACRO PTZEROP (TERMS) `(NULL ,TERMS)) ;for poly terms
|
|
(DEFMACRO PTZERO () '())
|
|
|
|
#-LISPM
|
|
(DEFMACRO CZEROP (C) `(SIGNP E ,C))
|
|
#+LISPM
|
|
(DEFMACRO CZEROP (C) `(LET ((.C. ,C)) (AND (NUMBERP .C.) (ZEROP .C.))))
|
|
|
|
(DEFMACRO CMINUS (C) `(MINUS ,C))
|
|
(DEFMACRO CMINUSP (C) `(MINUSP ,C))
|
|
(DEFMACRO CDERIVATIVE (NIL NIL) 0)
|
|
|
|
;; Similar to REMOVE on the Lisp Machine
|
|
(DEFMACRO DELET (ITEM LIST) `(DELETE ,ITEM (APPEND ,LIST NIL)))
|
|
|
|
;; The rational function package uses GENSYM's to represent variables.
|
|
;; The PDP-10 implementation used to use the PRINTNAME of the gensym
|
|
;; as a place to store a VALUE. Somebody changed this to value-cell instead,
|
|
;; even though using the value-cell costs more. Anyway, in NIL I want it
|
|
;; to use the property list, as thats a lot cheaper than creating a value
|
|
;; cell. Actually, better to use the PACKAGE slot, a kludge is a kludge right?
|
|
|
|
(DEFMACRO VALGET (ITEM)
|
|
#+NIL `(GET ,ITEM 'GENSYMVAL)
|
|
#-NIL `(SYMEVAL ,ITEM))
|
|
|
|
(DEFMACRO VALPUT (ITEM VAL)
|
|
`(SETF (VALGET ,ITEM) ,VAL))
|
|
|
|
|
|
(DEFUN ALGV MACRO (L) `(AND $ALGEBRAIC (GET ,(CADR L) 'TELLRAT)))
|
|
|
|
(DEFMACRO EQN (&REST L) `(EQUAL . ,L))
|
|
|
|
(DEFMACRO RZERO () ''(0 . 1))
|
|
(DEFMACRO RZEROP (A) `(PZEROP (CAR ,A)))
|
|
|
|
(defmacro PRIMPART (p) `(cadr (oldcontent ,p)))
|
|
|
|
;;poly constructor
|
|
|
|
(defmacro make-poly (var &optional (terms-or-e nil options?) (c nil e-c?)
|
|
(terms nil terms?))
|
|
(cond ((null options?) `(cons ,var '(1 1)))
|
|
((null e-c?) `(psimp ,var ,terms-or-e))
|
|
((null terms?) `(list ,var ,terms-or-e ,c))
|
|
(t `(psimp ,var (list* ,terms-or-e ,c ,terms)))))
|
|
|
|
;;Poly selector functions
|
|
|
|
(defmacro P-VAR (p) `(car ,p))
|
|
|
|
(defmacro P-TERMS (p) `(cdr ,p))
|
|
|
|
(defmacro P-LC (p) `(caddr ,p)) ;leading coefficient
|
|
|
|
(defmacro P-LE (p) `(cadr ,p))
|
|
|
|
(defmacro P-RED (p) `(cdddr ,p))
|
|
|
|
;;poly terms selectors
|
|
|
|
(defmacro PT-LC (terms) `(cadr ,terms))
|
|
|
|
(defmacro PT-LE (terms) `(car ,terms))
|
|
|
|
(defmacro PT-RED (terms) `(cddr ,terms))
|
|
|
|
;; Taken from SININT and RISCH. Somebody document these please.
|
|
|
|
(DEFMACRO R+ (R . L)
|
|
(COND ((NULL L) R)
|
|
(T `(RATPL ,R (R+ ,@L)))))
|
|
|
|
(DEFMACRO R* (R . L)
|
|
(COND ((NULL L) R)
|
|
(T `(RATTI ,R (R* ,@L) T))))
|
|
|
|
(DEFMACRO R- (R . L)
|
|
(COND ((NULL L) `(RATMINUS (RATFIX ,R)))
|
|
(T `(RATDIF (RATFIX ,R) (R+ ,@L)))))
|
|
|