mdw@git.distorted.org.uk Git - sod/blob - src/codegen-proto.lisp

   1 ;;; -*-lisp-*-
   2 ;;;
   3 ;;; Code generation protocol
   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 ;; Protocol.
  32
  33 (export 'format-temporary-name)
  34 (defgeneric format-temporary-name (var stream)
  35   (:documentation
  36    "Write the name of a temporary variable VAR to STREAM."))
  37
  38 (export 'var-in-use-p)
  39 (defgeneric var-in-use-p (var)
  40   (:documentation
  41    "Answer whether VAR is currently being used.  See `with-temporary-var'.")
  42   (:method (var)
  43     "Non-temporary variables are always in use."
  44     (declare (ignore var))
  45     t))
  46 (defgeneric (setf var-in-use-p) (value var)
  47   (:documentation
  48    "Record whether VAR is currently being used.  See `with-temporary-var'."))
  49
  50 ;; Root class.
  51
  52 (export 'temporary-name)
  53 (defclass temporary-name ()
  54   ((tag :initarg :tag :reader temp-tag))
  55   (:documentation
  56    "Base class for temporary variable and argument names."))
  57
  58 ;; Important variables.
  59
  60 (defparameter *temporary-index* 0
  61   "Index for temporary name generation.
  62
  63    This is automatically reset to zero before the output functions are
  64    invoked to write a file.  This way, we can ensure that the same output
  65    file is always produced from the same input.")
  66
  67 (define-clear-the-decks reset-codegen-index
  68   (setf *temporary-index* 0))
  69
  70 ;; Important temporary names.
  71
  72 (export '(*sod-ap* *sod-master-ap*))
  73 (defparameter *sod-ap*
  74   (make-instance 'temporary-name :tag "sod__ap"))
  75 (defparameter *sod-master-ap*
  76   (make-instance 'temporary-name :tag "sod__master_ap"))
  77
  78 ;;;--------------------------------------------------------------------------
  79 ;;; Instructions.
  80
  81 ;; Classes.
  82
  83 (export 'inst)
  84 (defclass inst () ()
  85   (:documentation
  86    "A base class for instructions.
  87
  88    An `instruction' is anything which might be useful to string into a code
  89    generator.  Both statements and expressions can be represented by trees of
  90    instructions.  The `definst' macro is a convenient way of defining new
  91    instructions.
  92
  93    The only important protocol for instructions is output, which is achieved
  94    by calling `print-object' with `*print-escape*' nil.
  95
  96    This doesn't really do very much, but it acts as a handy marker for
  97    instruction subclasses."))
  98
  99 (export 'inst-metric)
 100 (defgeneric inst-metric (inst)
 101   (:documentation
 102    "Returns a `metric' describing how complicated INST is.
 103
 104    The default metric of an inst node is simply 1; `inst' subclasses
 105    generated by `definst' (q.v.) have an automatically generated method which
 106    returns one plus the sum of the metrics of the node's children.
 107
 108    This isn't intended to be a particularly rigorous definition.  Its purpose
 109    is to allow code generators to make decisions about inlining or calling
 110    code fairly simply.")
 111   (:method ((inst t))
 112     (declare (ignore inst))
 113     1)
 114   (:method ((inst null))
 115     (declare (ignore inst))
 116     1)
 117   (:method ((inst list))
 118     (reduce #'+ inst :key #'inst-metric)))
 119
 120 ;; Instruction definition.
 121
 122 (export 'definst)
 123 (defmacro definst (code (streamvar) args &body body)
 124   "Define an instruction type and describe how to output it.
 125
 126    An `inst' can represent any structured piece of output syntax: a
 127    statement, expression or declaration, for example.  This macro defines the
 128    following things:
 129
 130      * A class `CODE-inst' to represent the instruction.
 131
 132      * Instance slots named after the ARGS, with matching keyword initargs,
 133        and `inst-ARG' readers.
 134
 135      * A constructor `make-CODE-inst' which accepts the ARGS (in order, not
 136        with keywords) as arguments and returns a fresh instance.
 137
 138      * A print method, which prints a diagnostic dump if `*print-escape*' is
 139        set, or invokes the BODY (with STREAMVAR bound to the output stream)
 140        otherwise.  The BODY is expected to produce target code at this
 141        point."
 142
 143   (let ((inst-var (gensym "INST"))
 144         (class-name (symbolicate code '-inst))
 145         (keys (mapcar (lambda (arg) (intern (symbol-name arg) :keyword))
 146                       args)))
 147     `(progn
 148        (defclass ,class-name (inst)
 149          ,(mapcar (lambda (arg key)
 150                     `(,arg :initarg ,key :reader ,(symbolicate 'inst- arg)))
 151                   args keys))
 152        (defun ,(symbolicate 'make- code '-inst) (,@args)
 153          (make-instance ',class-name ,@(mappend #'list keys args)))
 154        (defmethod inst-metric ((,inst-var ,class-name))
 155          (with-slots (,@args) ,inst-var
 156            (+ 1 ,@(mapcar (lambda (arg) `(inst-metric ,arg)) args))))
 157        (defmethod print-object ((,inst-var ,class-name) ,streamvar)
 158          (with-slots (,@args) ,inst-var
 159            (if *print-escape*
 160                (print-unreadable-object (,inst-var ,streamvar :type t)
 161                  (format stream "~@<~@{~S ~@_~S~^ ~_~}~:>"
 162                          ,@(mappend #'list keys args)))
 163                (progn ,@body)))))))
 164
 165 ;; Important instruction classes.
 166
 167 (export '(block-inst make-block-inst var-inst make-var-inst
 168           function-inst make-function-inst set-inst make-set-inst
 169           return-inst make-return-inst expr-inst make-expr-inst
 170           inst-decls inst-body inst-name inst-type inst-init inst-var
 171           inst-expr))
 172
 173 (definst var (stream) (name type init)
 174   (pprint-c-type type stream name)
 175   (when init
 176     (format stream " = ~A" init)))
 177 (definst set (stream) (var expr)
 178   (format stream "~@<~A = ~@_~2I~A;~:>" var expr))
 179 (definst return (stream) (expr)
 180   (format stream "return~@[ (~A)~];" expr))
 181 (definst expr (stream) (expr)
 182   (format stream "~A;" expr))
 183 (definst block (stream) (decls body)
 184   (format stream "{~:@_~@<  ~2I~@[~{~A;~:@_~}~:@_~]~{~A~^~:@_~}~:>~:@_}"
 185           decls body))
 186 (definst function (stream) (name type body)
 187   (pprint-logical-block (stream nil)
 188     (princ "static " stream)
 189     (pprint-c-type type stream name)
 190     (format stream "~:@_~A~:@_~:@_" body)))
 191
 192 ;; Formatting utilities.
 193
 194 (defun format-compound-statement* (stream child morep thunk)
 195   "Underlying function for `format-compound-statement'."
 196   (cond ((typep child 'block-inst)
 197          (funcall thunk stream)
 198          (write-char #\space stream)
 199          (princ child stream)
 200          (when morep (write-char #\space stream)))
 201         (t
 202          (pprint-logical-block (stream nil)
 203            (funcall thunk stream)
 204            (write-char #\space stream)
 205            (pprint-indent :block 2 stream)
 206            (pprint-newline :linear stream)
 207            (princ child stream)
 208            (pprint-indent :block 0 stream)
 209            (case morep
 210              (:space
 211               (write-char #\space stream)
 212               (pprint-newline :linear stream))
 213              ((t)
 214               (pprint-newline :mandatory stream)))))))
 215
 216 (export 'format-compound-statement)
 217 (defmacro format-compound-statement
 218     ((stream child &optional morep) &body body)
 219   "Format a compound statement to STREAM.
 220
 221    The introductory material is printed by BODY.  The CHILD is formatted
 222    properly according to whether it's a `block-inst'.  If MOREP is true, then
 223    allow for more stuff following the child."
 224   `(format-compound-statement* ,stream ,child ,morep
 225                                (lambda (,stream) ,@body)))
 226
 227 ;;;--------------------------------------------------------------------------
 228 ;;; Code generation.
 229
 230 ;; Accessors.
 231
 232 (export 'codegen-functions)
 233 (defgeneric codegen-functions (codegen)
 234   (:documentation
 235    "Return the list of `function-inst's of completed functions."))
 236
 237 (export 'ensure-var)
 238 (defgeneric ensure-var (codegen name type &optional init)
 239   (:documentation
 240    "Add a variable to CODEGEN's list.
 241
 242    The variable is called NAME (which should be comparable using `equal' and
 243    print to an identifier) and has the given TYPE.  If INIT is present and
 244    non-nil it is an expression `inst' used to provide the variable with an
 245    initial value."))
 246
 247 (export '(emit-inst emit-insts))
 248 (defgeneric emit-inst (codegen inst)
 249   (:documentation
 250    "Add INST to the end of CODEGEN's list of instructions."))
 251 (defgeneric emit-insts (codegen insts)
 252   (:documentation
 253    "Add a list of INSTS to the end of CODEGEN's list of instructions.")
 254   (:method (codegen insts)
 255     (dolist (inst insts) (emit-inst codegen inst))))
 256
 257 (export 'codegen-push)
 258 (defgeneric codegen-push (codegen)
 259   (:documentation
 260    "Pushes the current code generation state onto a stack.
 261
 262    The state consists of the accumulated variables and instructions."))
 263
 264 (export 'codegen-pop)
 265 (defgeneric codegen-pop (codegen)
 266   (:documentation
 267    "Pops a saved state off of the CODEGEN's stack.
 268
 269    Returns the newly accumulated variables and instructions as lists, as
 270    separate values."))
 271
 272 (export 'codegen-add-function)
 273 (defgeneric codegen-add-function (codegen function)
 274   (:documentation
 275    "Adds a function to CODEGEN's list.
 276
 277    Actually, we're not picky: FUNCTION can be any kind of object that you're
 278    willing to find in the list returned by `codegen-functions'."))
 279
 280 (export 'temporary-var)
 281 (defgeneric temporary-var (codegen type)
 282   (:documentation
 283    "Return the name of a temporary variable.
 284
 285    The temporary variable will have the given TYPE, and will be marked
 286    in-use.  You should clear the in-use flag explicitly when you've finished
 287    with the variable -- or, better, use `with-temporary-var' to do the
 288    cleanup automatically."))
 289
 290 (export 'codegen-build-function)
 291 (defun codegen-build-function (codegen name type vars insts)
 292   "Build a function and add it to CODEGEN's list.
 293
 294    Returns the function's name."
 295   (codegen-add-function codegen
 296                         (make-function-inst name type
 297                                             (make-block-inst vars insts)))
 298   name)
 299
 300 (export 'codegen-pop-block)
 301 (defgeneric codegen-pop-block (codegen)
 302   (:documentation
 303    "Makes a block (`block-inst') out of the completed code in CODEGEN.")
 304   (:method (codegen)
 305     (multiple-value-bind (vars insts) (codegen-pop codegen)
 306       (make-block-inst vars insts))))
 307
 308 (export 'codegen-pop-function)
 309 (defgeneric codegen-pop-function (codegen name type)
 310   (:documentation
 311    "Makes a function out of the completed code in CODEGEN.
 312
 313    The NAME can be any object you like.  The TYPE should be a function type
 314    object which includes argument names.  The return value is the NAME.")
 315   (:method (codegen name type)
 316     (multiple-value-bind (vars insts) (codegen-pop codegen)
 317       (codegen-build-function codegen name type vars insts))))
 318
 319 (export 'with-temporary-var)
 320 (defmacro with-temporary-var ((codegen var type) &body body)
 321   "Evaluate BODY with VAR bound to a temporary variable name.
 322
 323    During BODY, VAR will be marked in-use; when BODY ends, VAR will be marked
 324    available for re-use."
 325   `(let ((,var (temporary-var ,codegen ,type)))
 326      (unwind-protect
 327           (progn ,@body)
 328        (setf (var-in-use-p ,var) nil))))
 329
 330 ;;;--------------------------------------------------------------------------
 331 ;;; Code generation idioms.
 332
 333 (export 'deliver-expr)
 334 (defun deliver-expr (codegen target expr)
 335   "Emit code to deliver the value of EXPR to the TARGET.
 336
 337    The TARGET may be one of the following.
 338
 339      * `:void', indicating that the value is to be discarded.  The expression
 340        will still be evaluated.
 341
 342      * `:void-return', indicating that the value is to be discarded (as for
 343        `:void') and furthermore a `return' from the current function should
 344        be forced after computing the value.
 345
 346      * `:return', indicating that the value is to be returned from the
 347        current function.
 348
 349      * A variable name, indicating that the value is to be stored in the
 350        variable.
 351
 352    In the cases of `:return', `:void' and `:void-return' targets, it is valid
 353    for EXPR to be nil; this signifies that no computation needs to be
 354    performed.  Variable-name targets require an expression."
 355
 356   (case target
 357     (:return (emit-inst codegen (make-return-inst expr)))
 358     (:void (when expr (emit-inst codegen (make-expr-inst expr))))
 359     (:void-return (when expr (emit-inst codegen (make-expr-inst expr)))
 360                   (emit-inst codegen (make-return-inst nil)))
 361     (t (emit-inst codegen (make-set-inst target expr)))))
 362
 363 (export 'convert-stmts)
 364 (defun convert-stmts (codegen target type func)
 365   "Invoke FUNC to deliver a value to a non-`:return' target.
 366
 367    FUNC is a function which accepts a single argument, a non-`:return'
 368    target, and generates statements which deliver a value (see
 369    `deliver-expr') of the specified TYPE to this target.  In general, the
 370    generated code will have the form
 371
 372      setup instructions...
 373      (deliver-expr CODEGEN TARGET (compute value...))
 374      cleanup instructions...
 375
 376    where the cleanup instructions are essential to the proper working of the
 377    generated program.
 378
 379    The `convert-stmts' function will call FUNC to generate code, and arrange
 380    that its value is correctly delivered to TARGET, regardless of what the
 381    TARGET is -- i.e., it lifts the restriction to non-`:return' targets.  It
 382    does this by inventing a new temporary variable."
 383
 384   (case target
 385     (:return (with-temporary-var (codegen var type)
 386                (funcall func var)
 387                (deliver-expr codegen target var)))
 388     (:void-return (funcall func :void)
 389                   (emit-inst codegen (make-return-inst nil)))
 390     (t (funcall func target))))
 391
 392 ;;;----- That's all, folks --------------------------------------------------