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