home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / mitsch75.zip / scheme-7_5_17-src.zip / scheme-7.5.17 / src / compiler / machines / mips / rgspcm.scm < prev    next >
Text File  |  1999-01-02  |  2KB  |  63 lines
  1. #| -*-Scheme-*-
  2.  
  3. $Id: rgspcm.scm,v 1.2 1999/01/02 06:06:43 cph Exp $
  4. $MC68020-Header: rgspcm.scm,v 4.1 87/12/30 07:05:38 GMT cph Exp $
  5.  
  6. Copyright (c) 1987, 1989, 1990, 1999 Massachusetts Institute of Technology
  7.  
  8. This program is free software; you can redistribute it and/or modify
  9. it under the terms of the GNU General Public License as published by
  10. the Free Software Foundation; either version 2 of the License, or (at
  11. your option) any later version.
  12.  
  13. This program is distributed in the hope that it will be useful, but
  14. WITHOUT ANY WARRANTY; without even the implied warranty of
  15. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16. General Public License for more details.
  17.  
  18. You should have received a copy of the GNU General Public License
  19. along with this program; if not, write to the Free Software
  20. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  21. |#
  22.  
  23. ;;;; RTL Generation: Special primitive combinations.  MIPS version.
  24.  
  25. (declare (usual-integrations))
  26.  
  27. (define (define-special-primitive-handler name handler)
  28.   (let ((primitive (make-primitive-procedure name true)))
  29.     (let ((entry (assq primitive special-primitive-handlers)))
  30.       (if entry
  31.       (set-cdr! entry handler)
  32.       (set! special-primitive-handlers
  33.         (cons (cons primitive handler)
  34.               special-primitive-handlers)))))
  35.   name)
  36.  
  37. (define (special-primitive-handler primitive)
  38.   (let ((entry (assq primitive special-primitive-handlers)))
  39.     (and entry
  40.      (cdr entry))))
  41.  
  42. (define special-primitive-handlers
  43.   '())
  44.  
  45. (define (define-special-primitive/standard primitive)
  46.   (define-special-primitive-handler primitive
  47.     rtl:make-invocation:special-primitive))
  48.  
  49. (define-special-primitive/standard '&+)
  50. (define-special-primitive/standard '&-)
  51. ;; (define-special-primitive/standard '&*)
  52. (define-special-primitive/standard '&/)
  53. (define-special-primitive/standard '&=)
  54. (define-special-primitive/standard '&<)
  55. (define-special-primitive/standard '&>)
  56. (define-special-primitive/standard '1+)
  57. (define-special-primitive/standard '-1+)
  58. (define-special-primitive/standard 'zero?)
  59. (define-special-primitive/standard 'positive?)
  60. (define-special-primitive/standard 'negative?)
  61.  
  62.  
  63.