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