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 / spectrum / inerly.scm < prev    next >
Encoding:
Text File  |  1999-01-02  |  1.9 KB  |  79 lines
  1. #| -*-Scheme-*-
  2.  
  3. $Id: inerly.scm,v 1.2 1999/01/02 06:06:43 cph Exp $
  4. $MC68020-Header: inerly.scm,v 1.6 88/08/31 06:00:59 GMT cph Exp $
  5.  
  6. Copyright (c) 1988, 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. ;;; Spectrum Instruction Set Macros.  Early version
  24. ;;; NOPs for now.
  25.  
  26. (declare (usual-integrations))
  27.  
  28. ;;;; Transformers and utilities
  29.  
  30. (define early-instructions '())
  31. (define early-transformers '())
  32.  
  33. (define (define-early-transformer name transformer)
  34.   (set! early-transformers
  35.     (cons (cons name transformer)
  36.           early-transformers)))
  37.  
  38. (define (eq-subset? s1 s2)
  39.   (or (null? s1)
  40.       (and (memq (car s1) s2)
  41.        (eq-subset? (cdr s1) s2))))
  42.  
  43. ;;; Instruction and addressing mode macros
  44.  
  45. (syntax-table-define early-syntax-table 'DEFINE-INSTRUCTION
  46.   (macro (opcode . patterns)
  47.     `(SET! EARLY-INSTRUCTIONS
  48.        (CONS
  49.         (LIST ',opcode
  50.           ,@(map (lambda (pattern)
  51.                `(early-parse-rule
  52.                  ',(car pattern)
  53.                  (lambda (pat vars)
  54.                    (early-make-rule
  55.                 pat
  56.                 vars
  57.                 (scode-quote
  58.                  (instruction->instruction-sequence
  59.                   ,(parse-instruction (cadr pattern)
  60.                               (cddr pattern)
  61.                               true)))))))
  62.              patterns))
  63.          EARLY-INSTRUCTIONS))))
  64.  
  65.  
  66.  
  67.  
  68.  
  69.  
  70.  
  71.  
  72.  
  73.  
  74.  
  75.  
  76.  
  77.  
  78.  
  79.