X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/aa14a4cddcb96b681d5c19a2ec8bad382f43b264..944bf9362ff51217b1617f85126d26e821b8aa91:/src/codegen-impl.lisp diff --git a/src/codegen-impl.lisp b/src/codegen-impl.lisp index 25413f8..ccc66a1 100644 --- a/src/codegen-impl.lisp +++ b/src/codegen-impl.lisp @@ -7,7 +7,7 @@ ;;;----- Licensing notice --------------------------------------------------- ;;; -;;; This file is part of the Sensble Object Design, an object system for C. +;;; This file is part of the Sensible Object Design, an object system for C. ;;; ;;; SOD is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by @@ -37,10 +37,19 @@ ((in-use-p :initarg :in-use-p :initform nil :type boolean :accessor var-in-use-p))) +(define-module-var *temporary-index* 0 + "Index for temporary name generation. + + This is automatically reset to zero before the output functions are + invoked to write a file. This way, we can ensure that the same output + file is always produced from the same input.") + +(define-clear-the-decks reset-codegen-index + (setf *temporary-index* 0)) + (defmethod commentify-argument-name ((name temporary-name)) nil) -(export 'temporary-function) (defun temporary-function () "Return a temporary function name." (make-instance 'temporary-function @@ -62,55 +71,6 @@ (format-temporary-name var stream))) ;;;-------------------------------------------------------------------------- -;;; Instruction types. - -;; Compound statements. - -(export '(if-inst make-if-inst - while-inst make-while-inst - do-inst make-do-inst - inst-condition inst-consequent inst-alternative inst-body)) - -(definst if (stream) (condition consequent alternative) - (format-compound-statement (stream consequent alternative) - (format stream "if (~A)" condition)) - (when alternative - (format-compound-statement (stream alternative) - (write-string "else" stream)))) - -(definst while (stream) (condition body) - (format-compound-statement (stream body) - (format stream "while (~A)" condition))) - -(definst do-while (stream) (body condition) - (format-compound-statement (stream body :space) - (write-string "do" stream)) - (format stream "while (~A);" condition)) - -;; Special varargs hacks. - -(export '(va-start-inst make-va-start-inst - va-copy-inst make-va-copy-inst - va-end-inst make-va-end-inst - inst-ap inst-arg inst-to inst-from)) - -(definst va-start (stream) (ap arg) - (format stream "va_start(~@<~A, ~_~A~:>);" ap arg)) - -(definst va-copy (stream) (to from) - (format stream "va_copy(~@<~A, ~_~A~:>);" to from)) - -(definst va-end (stream) (ap) - (format stream "va_end(~A);" ap)) - -;; Expressions. - -(export '(call-inst make-call-inst inst-func inst-args)) - -(definst call (stream) (func args) - (format stream "~A(~@<~{~A~^, ~_~}~:>)" func args)) - -;;;-------------------------------------------------------------------------- ;;; Code generator objects. (defclass basic-codegen () @@ -121,11 +81,11 @@ (:documentation "Base class for code generator state. - This contains the bare essentials for supporting the EMIT-INST and - ENSURE-VAR protocols; see the documentation for those generic functions + This contains the bare essentials for supporting the `emit-inst' and + `ensure-var' protocols; see the documentation for those generic functions for more details. - This class isn't abstract. A full CODEGEN object uses instances of this + This class isn't abstract. A full `codegen' object uses instances of this to keep track of pending functions which haven't been completed yet. Just in case that wasn't clear enough: this is nothing to do with the @@ -137,26 +97,34 @@ (defmethod emit-insts ((codegen basic-codegen) insts) (asetf (codegen-insts codegen) (revappend insts it))) +(defmethod emit-decl ((codegen basic-codegen) inst) + (push inst (codegen-vars codegen))) + +(defmethod emit-decls ((codegen basic-codegen) insts) + (asetf (codegen-vars codegen) (revappend insts it))) + (defmethod ensure-var ((codegen basic-codegen) name type &optional init) (let* ((vars (codegen-vars codegen)) - (var (find name vars :key #'inst-name :test #'equal))) + (var (find name + (remove-if-not (lambda (var) (typep var 'var-inst)) vars) + :key #'inst-name :test #'equal))) (cond ((not var) (setf (codegen-vars codegen) (cons (make-var-inst name type init) vars))) ((not (c-type-equal-p type (inst-type var))) - (error "(Internal) Redefining type for variable ~A." name))) + (error "(Internal) Redefining type for variable ~A" name))) name)) (export 'codegen) (defclass codegen (basic-codegen) - ((functions :initform nil :type list :accessor codegen-functions) + ((functions :initform nil :type list :reader codegen-functions) (stack :initform nil :type list :accessor codegen-stack)) (:documentation "A full-fat code generator which can generate and track functions. This is the real deal. Subclasses may which to attach additional state for convenience's sake, but this class is self-contained. It supports the - CODEGEN-PUSH, CODEGEN-POP and CODEGEN-POP-FUNCTION protocols.")) + `codegen-push', `codegen-pop' and `codegen-pop-function' protocols.")) (defmethod codegen-push ((codegen codegen)) (with-slots (vars insts temp-index stack) codegen @@ -188,12 +156,12 @@ (c-type-equal-p type (inst-type var))) name nil))) - vars) + (remove-if-not (lambda (var) (typep var 'var-inst)) vars)) (let* ((name (make-instance 'temporary-variable :in-use-p t :tag (prog1 temp-index (incf temp-index))))) - (push (make-var-inst name type nil) vars) + (push (make-var-inst name type) vars) name)))) ;;;----- That's all, folks --------------------------------------------------