mirror of
https://github.com/PDP-10/its.git
synced 2026-05-10 09:26:24 +00:00
90 lines
2.0 KiB
Common Lisp
90 lines
2.0 KiB
Common Lisp
;;;;;;;;;;;;;;;;;;; -*- Mode: Lisp; Package: Macsyma -*- ;;;;;;;;;;;;;;;;;;;
|
|
;;; (c) Copyright 1976, 1983 Massachusetts Institute of Technology ;;;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(macsyma-module numerm macro)
|
|
|
|
;;; Macros for interface of lisp numerical routines to macsyma,
|
|
;;; for use with the functions in Maxsrc;Numer.
|
|
|
|
(defmacro make-array$ (&rest l)
|
|
#+(or Maclisp NIL)
|
|
`(*array nil 'flonum ,@l)
|
|
#+LISPM
|
|
`(make-array (list ,@l) ':type 'art-float)
|
|
)
|
|
|
|
|
|
(defmacro make-array% (&rest l)
|
|
#+(or Maclisp NIL)
|
|
`(*array nil 'fixnum ,@l)
|
|
#+Lispm
|
|
`(make-array (list ,@l) ':type 'art-q)
|
|
)
|
|
|
|
(defmacro aref$ (&rest l)
|
|
#+(or Maclisp NIL)
|
|
`(arraycall flonum ,@l)
|
|
#+(or Franz Lispm)
|
|
`(aref ,@l)
|
|
)
|
|
|
|
(defmacro aref% (&rest l)
|
|
#+(OR Maclisp NIL)
|
|
`(arraycall fixnum ,@l)
|
|
#+Lispm
|
|
`(aref ,@l)
|
|
)
|
|
|
|
(defmacro free-array% (a)
|
|
#+Maclisp
|
|
`(*rearray ,a)
|
|
#+(OR Lispm NIL)
|
|
;; not useful to call return-array unless it is at end of area.
|
|
;; programs do better to save arrays as a resource, this works
|
|
;; in maclisp too.
|
|
a
|
|
)
|
|
(defmacro free-array$ (a)
|
|
#+maclisp
|
|
`(*rearray ,a)
|
|
#+(OR Lispm NIL)
|
|
a
|
|
)
|
|
|
|
|
|
(DEFMACRO DEFBINDTRAMP$ (NARGS)
|
|
(LET ((BIND-TRAMP$ #-Multics (SYMBOLCONC 'bind-tramp nargs '$)
|
|
#+Multics (implode (mapcan 'exploden
|
|
(list 'bind-tramp nargs '$))))
|
|
(TRAMP$ #-Multics (SYMBOLCONC 'tramp nargs '$)
|
|
#+Multics (implode (mapcan 'exploden (list 'tramp nargs '$)))))
|
|
;;;When Multics gets symbolconc the above conditionalization can be removed.
|
|
`(PROGN 'COMPILE
|
|
(IF (FBOUNDP 'SPECIAL) (SPECIAL ,TRAMP$))
|
|
(DEFMACRO ,BIND-TRAMP$ (F G &REST BODY)
|
|
`(LET ((,',TRAMP$))
|
|
(LET ((,F (MAKE-TRAMP$ ,G ,',NARGS)))
|
|
,@BODY))))))
|
|
|
|
(DEFBINDTRAMP$ 1)
|
|
(DEFBINDTRAMP$ 2)
|
|
(DEFBINDTRAMP$ 3)
|
|
|
|
(defmacro fcall$ (&rest l)
|
|
#+Maclisp
|
|
`(subrcall flonum ,@l)
|
|
#+(OR Lispm NIL Franz)
|
|
`(funcall ,@l)
|
|
)
|
|
|
|
;; Central location for some important declarations.
|
|
#+Maclisp
|
|
(IF (FBOUNDP 'FLONUM)
|
|
(FLONUM (GCALL1$ NIL NIL)
|
|
(GCALL2$ NIL NIL NIL)
|
|
(MTO-FLOAT NIL)
|
|
))
|
|
|
|
|