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 / rules4.scm < prev    next >
Encoding:
Text File  |  1999-01-02  |  3.8 KB  |  116 lines
  1. #| -*-Scheme-*-
  2.  
  3. $Id: rules4.scm,v 4.13 1999/01/02 06:06:43 cph Exp $
  4.  
  5. Copyright (c) 1988-1999 Massachusetts Institute of Technology
  6.  
  7. This program is free software; you can redistribute it and/or modify
  8. it under the terms of the GNU General Public License as published by
  9. the Free Software Foundation; either version 2 of the License, or (at
  10. your option) any later version.
  11.  
  12. This program is distributed in the hope that it will be useful, but
  13. WITHOUT ANY WARRANTY; without even the implied warranty of
  14. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15. General Public License for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with this program; if not, write to the Free Software
  19. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20. |#
  21.  
  22. ;;;; LAP Generation Rules: Interpreter Calls
  23. ;;; package: (compiler lap-syntaxer)
  24.  
  25. (declare (usual-integrations))
  26.  
  27. ;;;; Variable cache trap handling.
  28.  
  29. (define-rule statement
  30.   (INTERPRETER-CALL:CACHE-REFERENCE (? cont)
  31.                     (REGISTER (? extension))
  32.                     (? safe?))
  33.   cont                    ; ignored
  34.   (LAP ,@(load-interface-args! false extension false false)
  35.        ,@(invoke-interface-ble
  36.       (if safe?
  37.           code:compiler-safe-reference-trap
  38.           code:compiler-reference-trap))))
  39.  
  40. (define-rule statement
  41.   (INTERPRETER-CALL:CACHE-ASSIGNMENT (? cont)
  42.                      (REGISTER (? extension))
  43.                      (? value register-expression))
  44.   cont                    ; ignored
  45.   (LAP ,@(load-interface-args! false extension value false)
  46.        ,@(invoke-interface-ble code:compiler-assignment-trap)))
  47.  
  48. (define-rule statement
  49.   (INTERPRETER-CALL:CACHE-UNASSIGNED? (? cont)
  50.                       (REGISTER (? extension)))
  51.   cont                    ; ignored
  52.   (LAP ,@(load-interface-args! false extension false false)
  53.        ,@(invoke-interface-ble code:compiler-unassigned?-trap)))
  54.  
  55. ;;;; Interpreter Calls
  56.  
  57. ;;; All the code that follows is obsolete.  It hasn't been used in a while.
  58. ;;; It is provided in case the relevant switches are turned off, but there
  59. ;;; is no real reason to do this.  Perhaps the switches should be removed.
  60.  
  61. (define-rule statement
  62.   (INTERPRETER-CALL:ACCESS (? cont)
  63.                (? environment register-expression)
  64.                (? name))
  65.   cont                    ; ignored
  66.   (lookup-call code:compiler-access environment name))
  67.  
  68. (define-rule statement
  69.   (INTERPRETER-CALL:LOOKUP (? cont)
  70.                (? environment register-expression)
  71.                (? name)
  72.                (? safe?))
  73.   cont                    ; ignored
  74.   (lookup-call (if safe? code:compiler-safe-lookup code:compiler-lookup)
  75.            environment
  76.            name))
  77.  
  78. (define-rule statement
  79.   (INTERPRETER-CALL:UNASSIGNED? (? cont)
  80.                 (? environment register-expression)
  81.                 (? name))
  82.   cont                    ; ignored
  83.   (lookup-call code:compiler-unassigned? environment name))
  84.  
  85. (define-rule statement
  86.   (INTERPRETER-CALL:UNBOUND? (? cont)
  87.                  (? environment register-expression)
  88.                  (? name))
  89.   cont                    ; ignored
  90.   (lookup-call code:compiler-unbound? environment name))
  91.  
  92. (define (lookup-call code environment name)
  93.   (LAP ,@(load-interface-args! false environment false false)
  94.        ,@(load-constant name regnum:third-arg)
  95.        ,@(invoke-interface-ble code)))
  96.  
  97. (define-rule statement
  98.   (INTERPRETER-CALL:DEFINE (? cont)
  99.                (? environment register-expression)
  100.                (? name)
  101.                (? value register-expression))
  102.   cont                    ; ignored
  103.   (assignment-call code:compiler-define environment name value))
  104.  
  105. (define-rule statement
  106.   (INTERPRETER-CALL:SET! (? cont)
  107.              (? environment register-expression)
  108.              (? name)
  109.              (? value register-expression))
  110.   cont                    ; ignored
  111.   (assignment-call code:compiler-set! environment name value))
  112.  
  113. (define (assignment-call code environment name value)
  114.   (LAP ,@(load-interface-args! false environment false value)
  115.        ,@(load-constant name regnum:third-arg)
  116.        ,@(invoke-interface-ble code)))