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 / vax / rules4.scm < prev    next >
Encoding:
Text File  |  1999-01-02  |  5.0 KB  |  140 lines

  1. #| -*-Scheme-*-
  2.  
  3. $Id: rules4.scm,v 4.5 1999/01/02 06:06:43 cph Exp $
  4.  
  5. Copyright (c) 1987-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) (? extension) (? safe?))
  31.   (QUALIFIER (interpreter-call-argument? extension))
  32.   cont                    ; ignored
  33.   (let* ((set-extension
  34.       (interpreter-call-argument->machine-register! extension r2))
  35.      (clear-map (clear-map!)))
  36.     (LAP ,@set-extension
  37.      ,@clear-map
  38.      #|
  39.      ;; This should be enabled if the short-circuit code is written.
  40.      (JSB ,(if safe?
  41.            entry:compiler-safe-reference-trap
  42.            entry:compiler-reference-trap))
  43.      |#
  44.      ,@(invoke-interface-jsb (if safe?
  45.                      code:compiler-safe-reference-trap
  46.                      code:compiler-reference-trap)))))
  47.  
  48. (define-rule statement
  49.   (INTERPRETER-CALL:CACHE-ASSIGNMENT (? cont) (? extension) (? value))
  50.   (QUALIFIER (and (interpreter-call-argument? extension)
  51.           (interpreter-call-argument? value)))
  52.   cont                    ; ignored
  53.   (let* ((set-extension
  54.      (interpreter-call-argument->machine-register! extension r2))
  55.      (set-value (interpreter-call-argument->machine-register! value r3))
  56.      (clear-map (clear-map!)))
  57.     (LAP ,@set-extension
  58.      ,@set-value
  59.      ,@clear-map
  60.      #|
  61.      ;; This should be enabled if the short-circuit code is written.
  62.      (JSB ,entry:compiler-assignment-trap)
  63.      |#
  64.      ,@(invoke-interface-jsb code:compiler-assignment-trap))))
  65.  
  66. (define-rule statement
  67.   (INTERPRETER-CALL:CACHE-UNASSIGNED? (? cont) (? extension))
  68.   (QUALIFIER (interpreter-call-argument? extension))
  69.   cont                    ; ignored
  70.   (let* ((set-extension
  71.       (interpreter-call-argument->machine-register! extension r2))
  72.      (clear-map (clear-map!)))
  73.     (LAP ,@set-extension
  74.      ,@clear-map
  75.      ,@(invoke-interface-jsb code:compiler-unassigned?-trap))))
  76.  
  77. ;;;; Interpreter Calls
  78.  
  79. ;;; All the code that follows is obsolete.  It hasn't been used in a while.
  80. ;;; It is provided in case the relevant switches are turned off, but there
  81. ;;; is no real reason to do this.  Perhaps the switches should be removed.
  82.  
  83. (define-rule statement
  84.   (INTERPRETER-CALL:ACCESS (? cont) (? environment) (? name))
  85.   (QUALIFIER (interpreter-call-argument? environment))
  86.   cont                    ; ignored
  87.   (lookup-call code:compiler-access environment name))
  88.  
  89. (define-rule statement
  90.   (INTERPRETER-CALL:LOOKUP (? cont) (? environment) (? name) (? safe?))
  91.   (QUALIFIER (interpreter-call-argument? environment))
  92.   cont                    ; ignored
  93.   (lookup-call (if safe? code:compiler-safe-lookup code:compiler-lookup)
  94.            environment name))
  95.  
  96. (define-rule statement
  97.   (INTERPRETER-CALL:UNASSIGNED? (? cont) (? environment) (? name))
  98.   (QUALIFIER (interpreter-call-argument? environment))
  99.   cont                    ; ignored
  100.   (lookup-call code:compiler-unassigned? environment name))
  101.  
  102. (define-rule statement
  103.   (INTERPRETER-CALL:UNBOUND? (? cont) (? environment) (? name))
  104.   (QUALIFIER (interpreter-call-argument? environment))
  105.   cont                    ; ignored
  106.   (lookup-call code:compiler-unbound? environment name))
  107.  
  108. (define (lookup-call code environment name)
  109.   (let* ((set-environment
  110.       (interpreter-call-argument->machine-register! environment r2))
  111.      (clear-map (clear-map!)))
  112.     (LAP ,@set-environment
  113.      ,@clear-map
  114.      ,@(load-constant name (INST-EA (R 3)))
  115.      ,@(invoke-interface-jsb code))))
  116.  
  117. (define-rule statement
  118.   (INTERPRETER-CALL:DEFINE (? environment) (? cont) (? name) (? value))
  119.   (QUALIFIER (and (interpreter-call-argument? environment)
  120.           (interpreter-call-argument? value)))
  121.   cont                    ; ignored
  122.   (assignment-call code:compiler-define environment name value))
  123.  
  124. (define-rule statement
  125.   (INTERPRETER-CALL:SET! (? environment) (? cont) (? name) (? value))
  126.   (QUALIFIER (and (interpreter-call-argument? environment)
  127.           (interpreter-call-argument? value)))
  128.   cont                    ; ignored
  129.   (assignment-call code:compiler-set! environment name value))
  130.  
  131. (define (assignment-call code environment name value)
  132.   (let* ((set-environment
  133.       (interpreter-call-argument->machine-register! environment r2))
  134.      (set-value (interpreter-call-argument->machine-register! value r4))
  135.      (clear-map (clear-map!)))
  136.     (LAP ,@set-environment
  137.      ,@set-value
  138.      ,@clear-map
  139.      ,@(load-constant name (INST-EA (R 3)))
  140.      ,@(invoke-interface-jsb code))))