1#| -*-Scheme-*- 2 3Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 4 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 5 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014 Massachusetts 6 Institute of Technology 7 8This file is part of MIT/GNU Scheme. 9 10MIT/GNU Scheme is free software; you can redistribute it and/or modify 11it under the terms of the GNU General Public License as published by 12the Free Software Foundation; either version 2 of the License, or (at 13your option) any later version. 14 15MIT/GNU Scheme is distributed in the hope that it will be useful, but 16WITHOUT ANY WARRANTY; without even the implied warranty of 17MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 18General Public License for more details. 19 20You should have received a copy of the GNU General Public License 21along with MIT/GNU Scheme; if not, write to the Free Software 22Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, 23USA. 24 25|# 26 27;;;; LAP Generation Rules: Interpreter Calls 28;;; package: (compiler lap-syntaxer) 29 30(declare (usual-integrations)) 31 32;;;; Variable cache trap handling. 33 34(define-rule statement 35 (INTERPRETER-CALL:CACHE-REFERENCE (? cont) (? extension) (? safe?)) 36 (QUALIFIER (interpreter-call-argument? extension)) 37 cont ; ignored 38 (let ((set-extension 39 (interpreter-call-argument->machine-register! extension rdx))) 40 (LAP ,@set-extension 41 ,@(clear-map!) 42 #| 43 ,@(invoke-interface/call 44 (if safe? 45 code:compiler-safe-reference-trap 46 code:compiler-reference-trap)) 47 |# 48 ,@(invoke-hook/call (if safe? 49 entry:compiler-safe-reference-trap 50 entry:compiler-reference-trap))))) 51 52(define-rule statement 53 (INTERPRETER-CALL:CACHE-ASSIGNMENT (? cont) (? extension) (? value)) 54 (QUALIFIER (and (interpreter-call-argument? extension) 55 (interpreter-call-argument? value))) 56 cont ; ignored 57 (let* ((set-extension 58 (interpreter-call-argument->machine-register! extension rdx)) 59 (set-value (interpreter-call-argument->machine-register! value rcx))) 60 (LAP ,@set-extension 61 ,@set-value 62 ,@(clear-map!) 63 #| 64 ,@(invoke-interface/call code:compiler-assignment-trap) 65 |# 66 ,@(invoke-hook/call entry:compiler-assignment-trap)))) 67 68(define-rule statement 69 (INTERPRETER-CALL:CACHE-UNASSIGNED? (? cont) (? extension)) 70 (QUALIFIER (interpreter-call-argument? extension)) 71 cont ; ignored 72 (let ((set-extension 73 (interpreter-call-argument->machine-register! extension rdx))) 74 (LAP ,@set-extension 75 ,@(clear-map!) 76 ,@(invoke-interface/call code:compiler-unassigned?-trap)))) 77 78;;;; Interpreter Calls 79 80;;; All the code that follows is obsolete. It hasn't been used in a while. 81;;; It is provided in case the relevant switches are turned off, but there 82;;; is no real reason to do this. Perhaps the switches should be removed. 83 84(define-rule statement 85 (INTERPRETER-CALL:ACCESS (? cont) (? environment) (? name)) 86 (QUALIFIER (interpreter-call-argument? environment)) 87 cont ; ignored 88 (lookup-call code:compiler-access environment name)) 89 90(define-rule statement 91 (INTERPRETER-CALL:LOOKUP (? cont) (? environment) (? name) (? safe?)) 92 (QUALIFIER (interpreter-call-argument? environment)) 93 cont ; ignored 94 (lookup-call (if safe? code:compiler-safe-lookup code:compiler-lookup) 95 environment name)) 96 97(define-rule statement 98 (INTERPRETER-CALL:UNASSIGNED? (? cont) (? environment) (? name)) 99 (QUALIFIER (interpreter-call-argument? environment)) 100 cont ; ignored 101 (lookup-call code:compiler-unassigned? environment name)) 102 103(define-rule statement 104 (INTERPRETER-CALL:UNBOUND? (? cont) (? environment) (? name)) 105 (QUALIFIER (interpreter-call-argument? environment)) 106 cont ; ignored 107 (lookup-call code:compiler-unbound? environment name)) 108 109(define (lookup-call code environment name) 110 (let ((set-environment 111 (interpreter-call-argument->machine-register! environment rdx))) 112 (LAP ,@set-environment 113 ,@(clear-map (clear-map!)) 114 ,@(load-constant (INST-EA (R ,rcx)) name) 115 ,@(invoke-interface/call code)))) 116 117(define-rule statement 118 (INTERPRETER-CALL:DEFINE (? cont) (? environment) (? 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! (? cont) (? environment) (? 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 rdx)) 134 (set-value (interpreter-call-argument->machine-register! value r8))) 135 (LAP ,@set-environment 136 ,@set-value 137 ,@(clear-map!) 138 ,@(load-constant (INST-EA (R ,rcx)) name) 139 ,@(invoke-interface/call code))))