diff --git a/wip-duuqnd/user-side-compiler/high-level.lisp b/wip-duuqnd/user-side-compiler/high-level.lisp index 34d1d0f..9ef0b1a 100644 --- a/wip-duuqnd/user-side-compiler/high-level.lisp +++ b/wip-duuqnd/user-side-compiler/high-level.lisp @@ -1,34 +1,6 @@ (in-package #:user-side-compiler) -(defparameter *varvec* (make-label :name "VARVEC" :address #x8100)) -(defparameter *argvec* (make-label :name "ARGVEC" :address #xF0)) - -(defvar *instruction-source* nil) -(defvar *compile-result*) - -(defun produce-instruction (instruction-class &optional operand) - (push (make-instance instruction-class :operand operand :source *instruction-source*) - *compile-result*)) - -(defun produce-label (&optional label) - (when (null label) - (setf label (make-label))) - (push label *compile-result*) - label) - -(defun produce-comment (text) - (push text *compile-result*)) - -(defmacro format-inst (destination control-string &rest format-arguments) - `(format ,destination "~C~A~%" #\Tab (format nil ,control-string ,@format-arguments))) - -;;; Dereferencing - -(defmethod dereference ((ref reference-constant)) - (produce-instruction 'inst-lda-immediate (ref-value ref))) - -(defmethod dereference ((ref reference-variable)) - (produce-instruction 'inst-lda-absolute (make-offset-label *varvec* (ref-index ref)))) +;;; Base node (defclass node () ((%next :accessor next :accessor normal-next :initform nil @@ -42,16 +14,64 @@ (defmethod node-nexts ((node node)) (list (normal-next node))) -(defmethod generate-code :before ((node node)) - (produce-comment (format nil "~A" node))) +;;; Basic nodes -(defmethod generate-code :after ((node node)) - (terpri)) +(defclass node-nop (node) ()) -(defmethod compile-node ((node node)) - (generate-code node) - (unless (null (next node)) - (compile-node (next node)))) +(defclass node-block (node) + ((%statements :accessor statements :initarg :statements))) + +(defclass node-program (node-block) ()) + +;;; Expression nodes + +(defclass node-expr (node) + ((%operands :accessor operands :initarg :operands) + (%operator-token :accessor operator-token :initarg :operator-token))) + +(define-transformation (node (node-expr node)) node) + +(defclass node-expr-grouping (node) + ((%expression :accessor expression :initarg :expression))) + +(define-transformation (node (node-expr-grouping node-expr)) node) + +(defmethod node-nexts ((node node-expr-grouping)) + (append (list (expression node)) (call-next-method))) + +(defclass node-assignment (node-expr) + ((%dst-variable :accessor dst-variable :initarg :variable) + (%value :accessor value :initarg :value))) + +(defmethod initialize-instance :after ((instance node-assignment) &rest initargs &key &allow-other-keys) + (declare (ignore initargs)) + (setf (operands instance) (list (dst-variable instance) + (value instance)))) + +(defmethod node-nexts ((node node-assignment)) + (append (when (nodep (value node)) + (list (value node))) + (call-next-method))) + +(defclass node-standard-expr (node-expr) ()) + +(defmacro define-standard-expr-node (name) + `(progn + (defclass ,name (node-standard-expr) ()) + (define-transformation (node (,name node-expr)) node))) + +(defmethod node-nexts ((node node-standard-expr)) + (append (remove-if-not #'nodep (operands node)) + (call-next-method))) + +(define-standard-expr-node node-expr-plus) +(define-standard-expr-node node-expr-minus) +(define-standard-expr-node node-expr-test-equal) +(define-standard-expr-node node-expr-test-not-equal) +(define-standard-expr-node node-expr-multiply) +(define-standard-expr-node node-expr-divide) + +;;; (defclass node-call (node) ((%callee :accessor callee :initarg :callee) @@ -61,30 +81,12 @@ (print-unreadable-object (object stream :type t :identity t) (format stream "~A~A" (callee object) (arguments object)))) -(defmethod generate-code ((node node-call)) - (let ((*instruction-source* node)) - (loop :for ref :in (arguments node) - :for index :from 0 - :do (dereference ref) - :do (produce-instruction 'inst-sta-absolute (make-offset-label *argvec* index))) - (produce-instruction 'inst-jsr-absolute (callee node)))) - (defclass node-branch (node) ((%branch-next :accessor branch-next :initarg :branch-next))) (defmethod node-nexts ((node node-branch)) (list (normal-next node) (branch-next node))) -(defmethod generate-code ((node node-branch)) - (let ((*instruction-source* node) - (else-label (make-label :name-prefix "ELSE"))) - (produce-instruction 'inst-lda-absolute "RESULT") - (produce-instruction 'inst-bne-relative else-label) - ;; The THEN branch - (compile-node (branch-next node)) - ;; The ELSE branch - (produce-label else-label))) - (defclass node-dotimes (node) ((%stop-ref :accessor stop-ref :initarg :stop-ref :documentation "A reference giving a value of how many times to run the loop.") @@ -95,36 +97,3 @@ (defmethod node-nexts ((node node-dotimes)) (append (list (loopee-node node)) (call-next-method))) - -(defmethod generate-code ((node node-dotimes)) - (let ((*instruction-source* node) - (loop-label (make-label :name-prefix "LOOPBACK"))) - (produce-instruction 'inst-txa-implied) - (produce-instruction 'inst-pha-implied) - - (dereference (stop-ref node)) - (produce-instruction 'inst-tax-implied) - (produce-label loop-label) - (compile-node (loopee-node node)) - (produce-instruction 'inst-dex-implied) - (produce-instruction 'inst-bne-relative loop-label) - - (produce-instruction 'inst-pla-implied) - (produce-instruction 'inst-tax-implied))) - -(defmethod compile-starting-at ((node node)) - (let ((*compile-result* '()) - (*label-counter* 0)) - (compile-node node) - (nreverse *compile-result*))) - -(defun make-call (callee args) - (let ((arguments - (loop :for (constp value) :in args - :with index := -1 - :if constp - :collect (make-instance 'reference-constant :value value) - :else - :collect (make-instance 'reference-variable :index (incf index))))) - (make-instance 'node-call :callee callee - :arguments arguments)))