3 ;;; Code generation protocol
5 ;;; (c) 2009 Straylight/Edgeware
8 ;;;----- Licensing notice ---------------------------------------------------
10 ;;; This file is part of the Sensble Object Design, an object system for C.
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.
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.
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.
28 ;;;--------------------------------------------------------------------------
33 (export 'format-temporary-name)
34 (defgeneric format-temporary-name (var stream)
36 "Write the name of a temporary variable VAR to STREAM."))
38 (export 'var-in-use-p)
39 (defgeneric var-in-use-p (var)
41 "Answer whether VAR is currently being used. See WITH-TEMPORARY-VAR.")
43 "Non-temporary variables are always in use."
45 (defgeneric (setf var-in-use-p) (value var)
47 "Record whether VAR is currently being used. See WITH-TEMPORARY-VAR."))
51 (export 'temporary-name)
52 (defclass temporary-name ()
53 ((tag :initarg :tag :reader temp-tag))
55 "Base class for temporary variable and argument names."))
57 ;; Important variables.
59 (defparameter *temporary-index* 0
60 "Index for temporary name generation.
62 This is automatically reset to zero before the output functions are
63 invoked to write a file. This way, we can ensure that the same output
64 file is always produced from the same input."
65 ;; FIXME: this is currently a lie. Need some protocol to ensure that this
69 ;; Important temporary names.
71 (export '(*sod-ap* *sod-master-ap*))
72 (defparameter *sod-ap*
73 (make-instance 'temporary-name :tag "sod__ap"))
74 (defparameter *sod-master-ap*
75 (make-instance 'temporary-name :tag "sod__master_ap"))
77 ;;;--------------------------------------------------------------------------
85 "A base class for instructions.
87 An `instruction' is anything which might be useful to string into a code
88 generator. Both statements and expressions map can be represented by
89 trees of instructions. The DEFINST macro is a convenient way of defining
92 The only important protocol for instructions is output, which is achieved
93 by calling PRINT-OBJECT with *PRINT-ESCAPE* nil.
95 This doesn't really do very much, but it acts as a handy marker for
96 instruction subclasses."))
99 (defgeneric inst-metric (inst)
101 "Returns a `metric' describing how complicated INST is.
103 The default metric of an inst node is simply 1; INST subclasses generated
104 by DEFINST (q.v.) have an automatically generated method which returns one
105 plus the sum of the metrics of the node's children.
107 This isn't intended to be a particularly rigorous definition. Its purpose
108 is to allow code generators to make decisions about inlining or calling
109 code fairly simply.")
112 ;; Instruction definition.
115 (defmacro definst (code (streamvar) args &body body)
116 "Define an instruction type and describe how to output it.
118 An INST can represent any structured piece of output syntax: a statement,
119 expression or declaration, for example. This macro defines the following
122 * A class CODE-INST to represent the instruction.
124 * Instance slots named after the ARGS, with matching keyword initargs,
125 and INST-ARG readers.
127 * A constructor MAKE-CODE-INST which accepts the ARGS (in order, not
128 with keywords) as arguments and returns a fresh instance.
130 * A print method, which prints a diagnostic dump if *PRINT-ESCAPE* is
131 set, or invokes the BODY (with STREAMVAR bound to the output stream)
132 otherwise. The BODY is expected to produce target code at this
135 (let ((inst-var (gensym "INST"))
136 (class-name (symbolicate code '-inst))
137 (keys (mapcar (lambda (arg) (intern (symbol-name arg) :keyword))
140 (defclass ,class-name (inst)
141 ,(mapcar (lambda (arg key)
142 `(,arg :initarg ,key :reader ,(symbolicate 'inst- arg)))
144 (defun ,(symbolicate 'make- code '-inst) (,@args)
145 (make-instance ',class-name ,@(mappend #'list keys args)))
146 (defmethod inst-metric ((,inst-var ,class-name))
147 (with-slots (,@args) ,inst-var
148 (+ 1 ,@(mapcar (lambda (arg) `(inst-metric ,arg)) args))))
149 (defmethod print-object ((,inst-var ,class-name) ,streamvar)
150 (with-slots (,@args) ,inst-var
152 (print-unreadable-object (,inst-var ,streamvar :type t)
153 (format stream "~@<~@{~S ~@_~S~^ ~_~}~:>"
154 ,@(mappend #'list keys args)))
157 ;; Important instruction classes.
159 (export '(block-inst make-block-inst var-inst make-var-inst
160 function-inst make-function-inst set-inst make-set-inst
161 return-inst make-return-inst expr-inst make-expr-inst
162 inst-decls inst-body inst-name inst-type inst-init inst-var
165 (definst var (stream) (name type init)
166 (pprint-c-type type stream name)
168 (format stream " = ~A" init)))
169 (definst set (stream) (var expr)
170 (format stream "~@<~A = ~@_~2I~A;~:>" var expr))
171 (definst return (stream) (expr)
172 (format stream "return~@[ (~A)~];" expr))
173 (definst expr (stream) (expr)
174 (format stream "~A;" expr))
175 (definst block (stream) (decls body)
176 (format stream "{~:@_~@< ~2I~@[~{~A;~:@_~}~:@_~]~{~A~^~:@_~}~:>~:@_}"
178 (definst function (stream) (name type body)
179 (pprint-logical-block (stream nil)
180 (princ "static " stream)
181 (pprint-c-type type stream name)
182 (format stream "~:@_~A~:@_~:@_" body)))
184 ;; Formatting utilities.
186 (defun format-compound-statement* (stream child morep thunk)
187 "Underlying function for FORMAT-COMPOUND-STATEMENT."
188 (cond ((typep child 'block-inst)
189 (funcall thunk stream)
190 (write-char #\space stream)
192 (when morep (write-char #\space stream)))
194 (pprint-logical-block (stream nil)
195 (funcall thunk stream)
196 (write-char #\space stream)
197 (pprint-indent :block 2 stream)
198 (pprint-newline :linear stream)
200 (pprint-indent :block 0 stream)
203 (write-char #\space stream)
204 (pprint-newline :linear stream))
206 (pprint-newline :mandatory stream)))))))
208 (export 'format-compound-statement)
209 (defmacro format-compound-statement
210 ((stream child &optional morep) &body body)
211 "Format a compound statement to STREAM.
213 The introductory material is printed by BODY. The CHILD is formatted
214 properly according to whether it's a BLOCK-INST. If MOREP is true, then
215 allow for more stuff following the child."
216 `(format-compound-statement* ,stream ,child ,morep
217 (lambda (,stream) ,@body)))
219 ;;;--------------------------------------------------------------------------
224 (export 'codegen-functions)
225 (defgeneric codegen-functions (codegen)
227 "Return the list of FUNCTION-INSTs of completed functions."))
230 (defgeneric ensure-var (codegen name type &optional init)
232 "Add a variable to CODEGEN's list.
234 The variable is called NAME (which should be comparable using EQUAL and
235 print to an identifier) and has the given TYPE. If INIT is present and
236 non-nil it is an expression INST used to provide the variable with an
239 (export '(emit-inst emit-insts))
240 (defgeneric emit-inst (codegen inst)
242 "Add INST to the end of CODEGEN's list of instructions."))
243 (defgeneric emit-insts (codegen insts)
245 "Add a list of INSTS to the end of CODEGEN's list of instructions.")
246 (:method (codegen insts)
247 (dolist (inst insts) (emit-inst codegen inst))))
249 (export 'codegen-push)
250 (defgeneric codegen-push (codegen)
252 "Pushes the current code generation state onto a stack.
254 The state consists of the accumulated variables and instructions."))
256 (export 'codegen-pop)
257 (defgeneric codegen-pop (codegen)
259 "Pops a saved state off of the CODEGEN's stack.
261 Returns the newly accumulated variables and instructions as lists, as
264 (export 'codegen-add-function)
265 (defgeneric codegen-add-function (codegen function)
267 "Adds a function to CODEGEN's list.
269 Actually, we're not picky: FUNCTION can be any kind of object that you're
270 willing to find in the list returned by CODEGEN-FUNCTIONS."))
272 (export 'temporary-var)
273 (defgeneric temporary-var (codegen type)
275 "Return the name of a temporary variable.
277 The temporary variable will have the given TYPE, and will be marked
278 in-use. You should clear the in-use flag explicitly when you've finished
279 with the variable -- or, better, use WITH-TEMPORARY-VAR to do the cleanup
282 (export 'codegen-build-function)
283 (defun codegen-build-function (codegen name type vars insts)
284 "Build a function and add it to CODEGEN's list.
286 Returns the function's name."
287 (codegen-add-function codegen
288 (make-function-inst name type
289 (make-block-inst vars insts)))
292 (export 'codegen-pop-block)
293 (defgeneric codegen-pop-block (codegen)
295 "Makes a block (BLOCK-INST) out of the completed code in CODEGEN.")
297 (multiple-value-bind (vars insts) (codegen-pop codegen)
298 (make-block-inst vars insts))))
300 (export 'codegen-pop-function)
301 (defgeneric codegen-pop-function (codegen name type)
303 "Makes a function out of the completed code in CODEGEN.
305 The NAME can be any object you like. The TYPE should be a function type
306 object which includes argument names. The return value is the NAME.")
307 (:method (codegen name type)
308 (multiple-value-bind (vars insts) (codegen-pop codegen)
309 (codegen-build-function codegen name type vars insts))))
311 (export 'with-temporary-var)
312 (defmacro with-temporary-var ((codegen var type) &body body)
313 "Evaluate BODY with VAR bound to a temporary variable name.
315 During BODY, VAR will be marked in-use; when BODY ends, VAR will be marked
316 available for re-use."
317 `(let ((,var (temporary-var ,codegen ,type)))
320 (setf (var-in-use-p ,var) nil))))
322 ;;;--------------------------------------------------------------------------
323 ;;; Code generation idioms.
325 (export 'deliver-expr)
326 (defun deliver-expr (codegen target expr)
327 "Emit code to deliver the value of EXPR to the TARGET.
329 The TARGET may be one of the following.
331 * :VOID, indicating that the value is to be discarded. The expression
332 will still be evaluated.
334 * :VOID-RETURN, indicating that the value is to be discarded (as for
335 :VOID) and furthermore a `return' from the current function should be
336 forced after computing the value.
338 * :RETURN, indicating that the value is to be returned from the current
341 * A variable name, indicating that the value is to be stored in the
344 In the cases of :RETURN, :VOID and :VOID-RETURN targets, it is valid for
345 EXPR to be nil; this signifies that no computation needs to be performed.
346 Variable-name targets require an expression."
349 (:return (emit-inst codegen (make-return-inst expr)))
350 (:void (when expr (emit-inst codegen (make-expr-inst expr))))
351 (:void-return (when expr (emit-inst codegen (make-expr-inst expr)))
352 (emit-inst codegen (make-return-inst nil)))
353 (t (emit-inst codegen (make-set-inst target expr)))))
355 (export 'convert-stmts)
356 (defun convert-stmts (codegen target type func)
357 "Invoke FUNC to deliver a value to a non-:RETURN target.
359 FUNC is a function which accepts a single argument, a non-:RETURN target,
360 and generates statements which deliver a value (see DELIVER-EXPR) of the
361 specified TYPE to this target. In general, the generated code will have
364 setup instructions...
365 (DELIVER-EXPR CODEGEN TARGET (compute value...))
366 cleanup instructions...
368 where the cleanup instructions are essential to the proper working of the
371 CONVERT-STMTS will call FUNC to generate code, and arrange that its value
372 is correctly delivered to TARGET, regardless of what the TARGET is --
373 i.e., it lifts the restriction to non-:RETURN targets. It does this by
374 inventing a new temporary variable."
377 (:return (with-temporary-var (codegen var type)
379 (deliver-expr codegen target var)))
380 (:void-return (funcall func :void)
381 (emit-inst codegen (make-return-inst nil)))
382 (t (funcall func target))))
384 ;;;----- That's all, folks --------------------------------------------------