;;;;;;;;;;;;;;;;;;; -*- 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)
	    ))