Commit | Line | Data |
---|---|---|
dea4d055 MW |
1 | ;;; -*-lisp-*- |
2 | ;;; | |
3 | ;;; Code generation protocol implementation | |
4 | ;;; | |
5 | ;;; (c) 2009 Straylight/Edgeware | |
6 | ;;; | |
7 | ||
8 | ;;;----- Licensing notice --------------------------------------------------- | |
9 | ;;; | |
10 | ;;; This file is part of the Sensble Object Design, an object system for C. | |
11 | ;;; | |
12 | ;;; SOD is free software; you can redistribute it and/or modify | |
13 | ;;; it under the terms of the GNU General Public License as published by | |
14 | ;;; the Free Software Foundation; either version 2 of the License, or | |
15 | ;;; (at your option) any later version. | |
16 | ;;; | |
17 | ;;; SOD is distributed in the hope that it will be useful, | |
18 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 | ;;; GNU General Public License for more details. | |
21 | ;;; | |
22 | ;;; You should have received a copy of the GNU General Public License | |
23 | ;;; along with SOD; if not, write to the Free Software Foundation, | |
24 | ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. | |
25 | ||
26 | (cl:in-package #:sod) | |
27 | ||
28 | ;;;-------------------------------------------------------------------------- | |
29 | ;;; Temporary names. | |
30 | ||
31 | (export '(temporary-argument temporary-function)) | |
32 | (defclass temporary-argument (temporary-name) ()) | |
33 | (defclass temporary-function (temporary-name) ()) | |
34 | ||
35 | (export 'temporary-variable) | |
36 | (defclass temporary-variable (temporary-name) | |
37 | ((in-use-p :initarg :in-use-p :initform nil | |
38 | :type boolean :accessor var-in-use-p))) | |
39 | ||
06339d58 MW |
40 | (define-module-var *temporary-index* 0 |
41 | "Index for temporary name generation. | |
42 | ||
43 | This is automatically reset to zero before the output functions are | |
44 | invoked to write a file. This way, we can ensure that the same output | |
45 | file is always produced from the same input.") | |
46 | ||
47 | (define-clear-the-decks reset-codegen-index | |
48 | (setf *temporary-index* 0)) | |
49 | ||
dea4d055 MW |
50 | (defmethod commentify-argument-name ((name temporary-name)) |
51 | nil) | |
52 | ||
dea4d055 MW |
53 | (defun temporary-function () |
54 | "Return a temporary function name." | |
55 | (make-instance 'temporary-function | |
56 | :tag (prog1 *temporary-index* (incf *temporary-index*)))) | |
57 | ||
58 | (defmethod format-temporary-name ((var temporary-name) stream) | |
59 | (format stream "~A" (temp-tag var))) | |
60 | (defmethod format-temporary-name ((var temporary-argument) stream) | |
61 | (format stream "sod__a~A" (temp-tag var))) | |
62 | (defmethod format-temporary-name ((var temporary-variable) stream) | |
63 | (format stream "sod__v~A" (temp-tag var))) | |
64 | (defmethod format-temporary-name ((var temporary-function) stream) | |
65 | (format stream "sod__f~A" (temp-tag var))) | |
66 | ||
67 | (defmethod print-object ((var temporary-name) stream) | |
68 | (if *print-escape* | |
69 | (print-unreadable-object (var stream :type t) | |
70 | (prin1 (temp-tag var) stream)) | |
71 | (format-temporary-name var stream))) | |
72 | ||
73 | ;;;-------------------------------------------------------------------------- | |
74 | ;;; Instruction types. | |
75 | ||
76 | ;; Compound statements. | |
77 | ||
4b8e5c03 MW |
78 | ;; HACK: use gensyms for the `condition' slots to avoid leaking the slot |
79 | ;; names, since the symbol `condition' actually comes from the `common-lisp' | |
80 | ;; package. The `definst' machinery will symbolicate the various associated | |
81 | ;; methods correctly despite this subterfuge. | |
82 | ||
83 | (definst if (stream :export t) (#1=#:condition consequent alternative) | |
dea4d055 | 84 | (format-compound-statement (stream consequent alternative) |
4b8e5c03 | 85 | (format stream "if (~A)" #1#)) |
dea4d055 MW |
86 | (when alternative |
87 | (format-compound-statement (stream alternative) | |
88 | (write-string "else" stream)))) | |
89 | ||
4b8e5c03 | 90 | (definst while (stream :export t) (#1=#:condition body) |
dea4d055 | 91 | (format-compound-statement (stream body) |
4b8e5c03 | 92 | (format stream "while (~A)" #1#))) |
dea4d055 | 93 | |
4b8e5c03 | 94 | (definst do-while (stream :export t) (body #1=#:condition) |
dea4d055 MW |
95 | (format-compound-statement (stream body :space) |
96 | (write-string "do" stream)) | |
4b8e5c03 | 97 | (format stream "while (~A);" #1#)) |
dea4d055 MW |
98 | |
99 | ;; Special varargs hacks. | |
100 | ||
418752c5 | 101 | (definst va-start (stream :export t) (ap arg) |
dea4d055 MW |
102 | (format stream "va_start(~@<~A, ~_~A~:>);" ap arg)) |
103 | ||
418752c5 | 104 | (definst va-copy (stream :export t) (to from) |
dea4d055 MW |
105 | (format stream "va_copy(~@<~A, ~_~A~:>);" to from)) |
106 | ||
418752c5 | 107 | (definst va-end (stream :export t) (ap) |
dea4d055 MW |
108 | (format stream "va_end(~A);" ap)) |
109 | ||
110 | ;; Expressions. | |
111 | ||
4b8e5c03 MW |
112 | ;; HACK: use a gensym for the `func' slot to avoid leaking the slot name, |
113 | ;; since the symbol `func' is exported from our package. | |
114 | (definst call (stream :export t) (#1=#:func args) | |
115 | (format stream "~A(~@<~{~A~^, ~_~}~:>)" #1# args)) | |
dea4d055 MW |
116 | |
117 | ;;;-------------------------------------------------------------------------- | |
118 | ;;; Code generator objects. | |
119 | ||
120 | (defclass basic-codegen () | |
121 | ((vars :initarg :vars :initform nil :type list :accessor codegen-vars) | |
122 | (insts :initarg :insts :initform nil :type list :accessor codegen-insts) | |
123 | (temp-index :initarg :temp-index :initform 0 | |
124 | :type fixnum :accessor codegen-temp-index)) | |
125 | (:documentation | |
126 | "Base class for code generator state. | |
127 | ||
3109662a MW |
128 | This contains the bare essentials for supporting the `emit-inst' and |
129 | `ensure-var' protocols; see the documentation for those generic functions | |
dea4d055 MW |
130 | for more details. |
131 | ||
3109662a | 132 | This class isn't abstract. A full `codegen' object uses instances of this |
dea4d055 MW |
133 | to keep track of pending functions which haven't been completed yet. |
134 | ||
135 | Just in case that wasn't clear enough: this is nothing to do with the | |
136 | BASIC language.")) | |
137 | ||
138 | (defmethod emit-inst ((codegen basic-codegen) inst) | |
139 | (push inst (codegen-insts codegen))) | |
140 | ||
141 | (defmethod emit-insts ((codegen basic-codegen) insts) | |
142 | (asetf (codegen-insts codegen) (revappend insts it))) | |
143 | ||
3f4ac959 MW |
144 | (defmethod emit-decl ((codegen basic-codegen) inst) |
145 | (push inst (codegen-vars codegen))) | |
146 | ||
147 | (defmethod emit-decls ((codegen basic-codegen) insts) | |
148 | (asetf (codegen-vars codegen) (revappend insts it))) | |
149 | ||
dea4d055 MW |
150 | (defmethod ensure-var ((codegen basic-codegen) name type &optional init) |
151 | (let* ((vars (codegen-vars codegen)) | |
66836e14 MW |
152 | (var (find name |
153 | (remove-if-not (lambda (var) (typep var 'var-inst)) vars) | |
154 | :key #'inst-name :test #'equal))) | |
dea4d055 MW |
155 | (cond ((not var) |
156 | (setf (codegen-vars codegen) | |
157 | (cons (make-var-inst name type init) vars))) | |
158 | ((not (c-type-equal-p type (inst-type var))) | |
159 | (error "(Internal) Redefining type for variable ~A." name))) | |
160 | name)) | |
161 | ||
162 | (export 'codegen) | |
163 | (defclass codegen (basic-codegen) | |
164 | ((functions :initform nil :type list :accessor codegen-functions) | |
165 | (stack :initform nil :type list :accessor codegen-stack)) | |
166 | (:documentation | |
167 | "A full-fat code generator which can generate and track functions. | |
168 | ||
169 | This is the real deal. Subclasses may which to attach additional state | |
170 | for convenience's sake, but this class is self-contained. It supports the | |
3109662a | 171 | `codegen-push', `codegen-pop' and `codegen-pop-function' protocols.")) |
dea4d055 MW |
172 | |
173 | (defmethod codegen-push ((codegen codegen)) | |
174 | (with-slots (vars insts temp-index stack) codegen | |
175 | (push (make-instance 'basic-codegen | |
176 | :vars vars | |
177 | :insts insts | |
178 | :temp-index temp-index) | |
179 | stack) | |
180 | (setf vars nil insts nil temp-index 0))) | |
181 | ||
182 | (defmethod codegen-pop ((codegen codegen)) | |
183 | (with-slots (vars insts temp-index stack) codegen | |
184 | (multiple-value-prog1 | |
185 | (values (nreverse vars) (nreverse insts)) | |
186 | (let ((sub (pop stack))) | |
187 | (setf vars (codegen-vars sub) | |
188 | insts (codegen-insts sub) | |
189 | temp-index (codegen-temp-index sub)))))) | |
190 | ||
191 | (defmethod codegen-add-function ((codegen codegen) function) | |
192 | (with-slots (functions) codegen | |
193 | (setf functions (nconc functions (list function))))) | |
194 | ||
195 | (defmethod temporary-var ((codegen basic-codegen) type) | |
196 | (with-slots (vars temp-index) codegen | |
197 | (or (some (lambda (var) | |
198 | (let ((name (inst-name var))) | |
199 | (if (and (not (var-in-use-p name)) | |
200 | (c-type-equal-p type (inst-type var))) | |
201 | name | |
202 | nil))) | |
66836e14 | 203 | (remove-if-not (lambda (var) (typep var 'var-inst)) vars)) |
dea4d055 MW |
204 | (let* ((name (make-instance 'temporary-variable |
205 | :in-use-p t | |
206 | :tag (prog1 temp-index | |
207 | (incf temp-index))))) | |
208 | (push (make-var-inst name type nil) vars) | |
209 | name)))) | |
210 | ||
211 | ;;;----- That's all, folks -------------------------------------------------- |