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 edx)))
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 edx))
59	 (set-value (interpreter-call-argument->machine-register! value ebx)))
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 edx)))
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 edx)))
112    (LAP ,@set-environment
113	 ,@(clear-map (clear-map!))
114	 ,@(load-constant (INST-EA (R ,ebx)) 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 edx))
134	 (set-value (interpreter-call-argument->machine-register! value eax)))
135    (LAP ,@set-environment
136	 ,@set-value
137	 ,@(clear-map!)
138	 (MOV W ,reg:utility-arg-4 (R ,eax))
139	 ,@(load-constant (INST-EA (R ,ebx)) name)
140	 ,@(invoke-interface/call code))))