home *** CD-ROM | disk | FTP | other *** search
/ Enter 2004 January / enter-2004-01.iso / files / maxima-5.9.0.exe / {app} / share / maxima / 5.9.0 / src / runtim.lisp < prev    next >
Encoding:
Text File  |  2003-02-09  |  3.6 KB  |  112 lines
  1. ;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;;;     The data in this file contains enhancments.                    ;;;;;
  4. ;;;                                                                    ;;;;;
  5. ;;;  Copyright (c) 1984,1987 by William Schelter,University of Texas   ;;;;;
  6. ;;;     All rights reserved                                            ;;;;;
  7. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  8. ;;;     (c) Copyright 1981 Massachusetts Institute of Technology         ;;;
  9. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10.  
  11. (in-package "MAXIMA")
  12. (macsyma-module runtim)
  13.  
  14. ;; This file contains functions which are also defined as macros in the
  15. ;; standard Macsyma environment.  They are defined here for the benefit
  16. ;; interpreted code in the fix file.  This file is used only in the ITS
  17. ;; implementation, as the Macsyma macros are present at runtime in large
  18. ;; address space systems.
  19.  
  20. ;; The above comment is idiotic. These functions are open-codeable,
  21. ;; and defined as macros only for efficiency. However, the correct
  22. ;; way to hack efficiency is through compiler:optimizers, which is
  23. ;; what we use now. This file is no longer its-only.
  24.  
  25. ;; Defined in LIBMAX;MAXMAC.
  26.  
  27. ;(DEFUN COPY (L) (SUBST NIL NIL L))  
  28. ;(DEFUN COPY1 (X) (APPEND X NIL))
  29.  
  30. ;; Defined in RAT;RATMAC.
  31.  
  32. ;(DEFUN EQN (X Y) (EQUAL X Y))
  33. ;(DEFUN PCOEFP (X) (ATOM X))
  34. ;(DEFUN PZEROP (L) (SIGNP E L))
  35. ;(DEFUN RCINV (X) (RATINVERT X))
  36.  
  37. ;; Defined in RAT;LESFAC.
  38.  
  39. ;(DEFUN GETDIS (X) (GET X 'DISREP))
  40. ;(DEFUN CONS1 (X) (CONS X 1))
  41.  
  42. ;; Defined in LIBMAX;MAXMAC.
  43.  
  44. ;(DEFPROP ERLIST ERLIST1 EXPR)
  45.  
  46. ;; Subr definitions of ADD* and MUL* needed at runtime for functions generated
  47. ;; by TRANSL.  If a function is defined as both a macro and a function, the
  48. ;; compiler expands the macro, but still puts the function definitions in the
  49. ;; fasl.  We don't need these on the Lisp Machine or Multics since macros are
  50. ;; around at run time. 
  51.  
  52. ;; ADD and MUL to be flushed shortly.  Around for compatibility only.
  53. ;; (another CWH comment????) -gjc
  54.  
  55. #+PDP10
  56. (PROGN 'COMPILE
  57.        (DEFUN ADD (&REST L) (SIMPLIFYA (CONS '(MPLUS) L) t))
  58.        (DEFUN MUL (&REST L) (SIMPLIFYA (CONS '(MTIMES) L) t))
  59.        (DEFUN ADD* (&REST L) (SIMPLIFYA (CONS '(MPLUS) L) nil))
  60.        (DEFUN MUL* (&REST L) (SIMPLIFYA (CONS '(MTIMES) L) nil)))
  61.  
  62. #+NIL
  63. (PROGN 'COMPILE
  64.        (DEFUN ADD (&RESTL L) (SIMPLIFYA (CONS '(MPLUS) L) t))
  65.        (DEFUN MUL (&RESTL L) (SIMPLIFYA (CONS '(MTIMES) L) t))
  66.        (DEFUN ADD* (&RESTL L) (SIMPLIFYA (CONS '(MPLUS) L) nil))
  67.        (DEFUN MUL* (&RESTL L) (SIMPLIFYA (CONS '(MTIMES) L) nil))
  68.  
  69. (DEFUN SETF-MGET (A B VALUE) (MPUTPROP A VALUE B))
  70.  
  71. (DEFUN SETF-$GET (A B VALUE) ($PUT A VALUE B))
  72. )
  73.  
  74. #+CL
  75. (PROGN 'COMPILE
  76.  
  77. ;; on the LISPM the &REST list is a stack-allocated cdr-coded list.
  78. ;; We have to copy it, so might as well try out some optimizations.
  79.  
  80. (DEFUN ADD (&REST V)
  81.   (DO ((L NIL)(R)
  82.           (ACC 0))
  83.       ((NULL V)
  84.        (IF (NULL L)
  85.        ACC
  86.        (IF (ZEROP ACC)
  87.            (SIMPLIFYA (CONS '(MPLUS) L) T)
  88.            (SIMPLIFYA (LIST* '(MPLUS) ACC L) T))))
  89.     (SETQ R (POP V))
  90.     (IF (NUMBERP R)
  91.     (SETQ ACC (PLUS R ACC))
  92.     (PUSH R L))))
  93.  
  94. (DEFUN MUL (&REST V)
  95.   (DO ((L NIL)(R)
  96.           (ACC 1))
  97.       ((NULL V)
  98.        (IF (NULL L)
  99.        ACC
  100.        (IF (EQUAL ACC 1)
  101.            (SIMPLIFYA (CONS '(MTIMES) L) T)
  102.            (SIMPLIFYA (LIST* '(MTIMES) ACC L) T))))
  103.     (SETQ R (POP V))
  104.     (IF (NUMBERP R)
  105.     (SETQ ACC (TIMES R ACC))
  106.     (PUSH R L))))
  107.  
  108. (DEFUN ADD* (&REST L) (SIMPLIFYA (CONS '(MPLUS) (copy-list L)) nil))
  109. (DEFUN MUL* (&REST L) (SIMPLIFYA (CONS '(MTIMES)(copy-list L)) nil))
  110.  
  111. )
  112.