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