.gitignore

@@ -5,4 +5,4 @@
 *.lst
 *.note
 *.sh
-c6lc
+

wip-duuqnd/user-side-compiler/asm-function.lisp

@@ -27,7 +27,6 @@
         asm-function
         (progn
           (cerror "Create dummy function with placeholder address."
-                  'missing-function-error
+                  "Tried to transform token into non-existent function ~A."
-                  :format-control "~A"
+                  (name token))
-                  :format-arguments (list (name token)))
           (add-asm-function (name token) #xC0FE)))))

wip-duuqnd/user-side-compiler/backend/code-generator.lisp

@@ -144,6 +144,9 @@ is the responsibility of the pre-assembly compilation step."
          (emit-lda (data-reference data))
          (setf *last-instruction* (list :load data)))))
 
+(defmethod compile-ir ((inst ir-inst))
+  (warn "Skipped compiling ~A; no COMPILE-IR method" inst))
+
 (defmethod compile-ir ((inst ir-return))
   (emit-asm-instruction :opcode #x60 :byte-length 1))
 
@@ -362,3 +365,36 @@ is the responsibility of the pre-assembly compilation step."
                                   (the (unsigned-byte 16) (operand asm-obj)))
                              (ldb (byte 8 8)
                                   (the (unsigned-byte 16) (operand asm-obj))))))))
+
+(defun quick-and-dirty-test-compile (text &key print-ir-p print-alloc-p make-asm-p)
+  (with-input-from-string (source-stream text)
+    (let ((*token-stream* (make-token-stream (tokenize source-stream text))))
+      (let ((rb (with-compilation-setup (root-block builder)
+                  (compile-node (match-syntax program) builder)
+                  root-block))
+            (return-values '()))
+        (do-iblocks (ib rb)
+          (optim-prepare-direct-instructions ib)
+          ;;(optim-commutative-constant-folding ib)
+          (optim-reorder-arguments ib)
+          (optim-call-duplicate-args ib)
+          (optim-remove-unused ib))
+        (push rb return-values)
+        (let ((allocations (allocate-values rb)))
+          (optim-reuse-temporary-slots rb allocations)
+          (when print-ir-p
+            (print-iblocks rb)
+            (terpri))
+          (when print-alloc-p
+            (loop :for allocation :in allocations
+                  :do (format t "~%~A - ~A~{ - ~A~}"
+                              (data allocation)
+                              (strategy allocation)
+                              (unless (null (varvec-index allocation))
+                                (list (varvec-index allocation)))))
+            (terpri))
+          (push allocations return-values)
+          (when make-asm-p
+            (with-variable-allocations allocations
+              (push (compile-iblocks rb) return-values))))
+        (values-list (nreverse return-values))))))

wip-duuqnd/user-side-compiler/backend/pre-assembly.lisp

@@ -1,64 +0,0 @@
-(in-package #:user-side-compiler)
-
-(defun optim-reuse-temporary-slots (start-iblock allocations)
-  (let ((free '()))
-    (do-iblocks (iblock start-iblock)
-      (do-instructions (inst iblock)
-        (let ((ending (find inst allocations
-                            :key (alexandria:compose #'last-use
-                                                     #'data)))
-              (beginning (find (output inst) allocations :key #'data)))
-          (cond ((and ending
-                      (eql (strategy ending) :temporary-variable)
-                      (not (null (varvec-index ending))))
-                 (pushnew (varvec-index ending) free))
-                ((and beginning
-                      (eql (strategy beginning) :temporary-variable)
-                      (not (null (varvec-index beginning)))
-                      (not (null free)))
-                 (setf (varvec-index beginning) (pop free)))))))))
-
-(defun optim-prepare-direct-instructions (iblock)
-  (do-instructions (inst iblock)
-    (when (typep inst 'ir-operation)
-      (assert (= (length (inputs inst)) 2))
-      (destructuring-bind (accumulator operand)
-          (inputs inst)
-        (when (typep (definition accumulator) '(or ir-fetchvar ir-getconst))
-          (move-instruction-above (definition accumulator) inst))
-        (when (typep (definition operand) '(or ir-fetchvar ir-getconst))
-          (when (typep (definition operand) 'ir-fetchvar)
-            (setf (inputs inst)
-                  (substitute (input (definition operand)) operand
-                              (inputs inst))))
-          (delete-instruction (definition operand)))))))
-
-(defparameter *operation-routines*
-  '((ir-mult . "mult")
-    (ir-div . "div")))
-
-(defun pre-assembly-software-operations (start-iblock)
-  (do-iblocks (ib start-iblock)
-    (do-instructions (inst ib)
-      (when (member (type-of inst) *operation-routines* :key #'car)
-        (let ((inputs (inputs inst))
-              (output (output inst))
-              (implementation (get-asm-function
-                               (cdr (assoc (type-of inst)
-                                           *operation-routines*)))))
-          (setf (inputs inst) '()
-                (output inst) nil)
-          (let ((new (make-instance 'ir-call
-                                    :callee implementation
-                                    :inputs inputs :output output)))
-            (insert-instruction-above new inst)
-            (delete-instruction inst)
-            ;; To ensure that the code walking continues correctly
-            (setf inst new)))))))
-
-(defun pre-assembly (iblock)
-  (pre-assembly-software-operations iblock)
-  (optim-prepare-direct-instructions iblock)
-  (let ((allocs (allocate-values iblock)))
-    (optim-reuse-temporary-slots iblock allocs)
-    allocs))

wip-duuqnd/user-side-compiler/backend/value-allocator.lisp

@@ -27,6 +27,21 @@
    (%strategy :accessor strategy :initform :temporary-variable)
    (%varvec-index :accessor varvec-index :initform nil)))
 
+(defun optim-prepare-direct-instructions (iblock)
+  (do-instructions (inst iblock)
+    (when (typep inst 'ir-operation)
+      (assert (= (length (inputs inst)) 2))
+      (destructuring-bind (accumulator operand)
+          (inputs inst)
+        (when (typep (definition accumulator) '(or ir-fetchvar ir-getconst))
+          (move-instruction-above (definition accumulator) inst))
+        (when (typep (definition operand) '(or ir-fetchvar ir-getconst))
+          (when (typep (definition operand) 'ir-fetchvar)
+            (setf (inputs inst)
+                  (substitute (input (definition operand)) operand
+                              (inputs inst))))
+          (delete-instruction (definition operand)))))))
+
 (defmethod choose-allocation-strategy ((alc value-allocation))
   (setf
    (strategy alc)
@@ -76,3 +91,21 @@
       (loop :for allocation :in (append named temporary)
             :do (setf (varvec-index allocation) (incf counter))))
     allocations))
+
+(defun optim-reuse-temporary-slots (start-iblock allocations)
+  (let ((free '()))
+    (do-iblocks (iblock start-iblock)
+      (do-instructions (inst iblock)
+        (let ((ending (find inst allocations
+                            :key (alexandria:compose #'last-use
+                                                     #'data)))
+              (beginning (find (output inst) allocations :key #'data)))
+          (cond ((and ending
+                      (eql (strategy ending) :temporary-variable)
+                      (not (null (varvec-index ending))))
+                 (pushnew (varvec-index ending) free))
+                ((and beginning
+                      (eql (strategy beginning) :temporary-variable)
+                      (not (null (varvec-index beginning)))
+                      (not (null free)))
+                 (setf (varvec-index beginning) (pop free)))))))))

wip-duuqnd/user-side-compiler/binary-test-build.lisp

@@ -1,32 +0,0 @@
-(in-package #:user-side-compiler)
-
-(defun batch-parse-options (arguments)
-  (let ((options '()))
-    (loop :with outputp := nil
-          :for arg :in arguments
-          :do (cond (outputp
-                     (setf (getf options :output) arg
-                           outputp nil))
-                    ((or (string= arg "-o") (string= arg "--output"))
-                     (setf outputp t))
-                    ((or (string= arg "-h") (string= arg "--help"))
-                     (setf (getf options :show-help-p) t))
-                    (t
-                     (setf (getf options :input) arg))))
-    options))
-
-(defun batch-main ()
-  (destructuring-bind (&key input output show-help-p)
-      (batch-parse-options (uiop:command-line-arguments))
-    (if show-help-p
-        (progn
-          (format t "Usage: c6lc [-o <output file>] <input file>~%")
-          (sb-ext:exit :code -1))
-        (batch-compile input output))))
-
-(defun build ()
-  (assert (not (member :swank *features*)))
-  (sb-ext:save-lisp-and-die "c6lc" :toplevel #'batch-main :executable t
-                                   :save-runtime-options t
-                                   :root-structures 'batch-main
-                                   :compression t))

wip-duuqnd/user-side-compiler/error-handling.lisp

@@ -36,13 +36,10 @@
                      (point-out-source (source c))))))
 
 (define-condition tokenizer-error (usc-error)
-  ((%context-string :initform "Tokenizing error:")))
+  ((%context-string :initform "Error in tokenizer:")))
-
-(define-condition missing-function-error (usc-error)
-  ((%context-string :initform "Non-existent function (TODO nicer error for this):")))
 
 (define-condition parser-error (usc-error)
-  ((%context-string :initform "Syntax error:")))
+  ())
 
 
 (defun error-parser (source format-control &rest format-arguments)

wip-duuqnd/user-side-compiler/example-6.c6l

@@ -1,3 +0,0 @@
-x = 1
-y = x + 4 + use(x) + 1
-z = use(y) + use(x)

wip-duuqnd/user-side-compiler/interface.lisp

@@ -1,204 +0,0 @@
-(in-package #:user-side-compiler)
-
-(defun usc-init ()
-  (setf *asm-functions* (make-hash-table :test #'equalp))
-  (populate-asm-functions))
-
-;;; CI - Compiler Interface
-
-(defun ci-tokenize (string)
-  "Tokenizes from STRING. Returns a list of tokens."
-  (with-input-from-string (input string)
-    (tokenize input string)))
-
-(defun ci-tokenize-info (tokens)
-  (flet
-      ((count-token-type (type)
-         (count-if (lambda (token)
-                     (typep token type))
-                   tokens)))
-    (format *debug-io* "Token count: ~D~%" (length tokens))
-    (loop :for (text type)
-            :in '(("End-of-statement tokens" token-end-of-statement)
-                  ("Atomic (simple character) tokens, excluding EOS"
-                   (and token-atomic (not token-end-of-statement)))
-                  ("Name tokens" token-name)
-                  ("Number tokens" token-number)
-                  ("Keyword tokens" token-keyword))
-          :do (format *debug-io* "~A: ~D~%" text (count-token-type type))))
-  (terpri *debug-io*))
-
-(defun ci-parse (tokens)
-  (let ((*token-stream* (make-token-stream tokens)))
-    (match-syntax program)))
-
-(defun ci-parse-info (syntax-tree)
-  ;; TODO
-  (terpri *debug-io*))
-
-(defun ci-compile-to-ir (syntax-tree)
-  (let ((iblock (make-instance 'iblock
-                               :name "toplevel"
-                               :program (make-instance 'ir-program)))
-        (builder (make-instance 'builder)))
-    (build-begin builder iblock)
-    (compile-node syntax-tree builder)
-    (fix-iblock-flow iblock)
-    (unless (null (next iblock))
-      (make-iblock-names-unique (next iblock)))
-    iblock))
-
-(defun ci-ir-info (iblock)
-  (let ((ir-count 0)
-        (unique-data-count 0))
-    (do-iblocks (ib iblock)
-      (do-instructions (inst ib)
-        (incf ir-count)
-        (incf unique-data-count
-              (+ (length (inputs inst))
-                 (if (typep inst 'ir-no-output)
-                     0
-                     1)))))
-    (format *debug-io* "IR instructions: ~D~%" ir-count)
-    (format *debug-io* "Data count: ~D~%" unique-data-count)
-    (terpri *debug-io*)))
-
-(defun ci-optimize-ir (start-iblock)
-  (do-iblocks (ib start-iblock)
-    (optim-reorder-arguments ib)
-    (optim-call-duplicate-args ib)
-    (optim-remove-unused ib)))
-
-(defun ci-allocation-info (allocs)
-  (format *debug-io* "Values: ~D~%" (length allocs))
-  (format *debug-io* "Allocated VARVEC slots: ~D~%"
-          (loop :with anyp := nil
-                :for alloc :in allocs
-                :when (member (strategy alloc)
-                              '(:named-variable :temporary-variable))
-                  :maximizing (1+ (varvec-index alloc))
-                  :and :do (setf anyp t)))
-  (loop :for (text strategy)
-          :in '(("Named variables" :named-variable)
-                ("Temporary variables" :temporary-variable)
-                ("Discarded values" :not-saved)
-                ("Immediately used (via register)" :accumulator)
-                ("Immediately used (function arguments)" :direct-to-argvec)
-                ("Immediately used (branches)" :branch)
-                ("Constants" :constant))
-        :do (format *debug-io* "~A: ~D~%" text
-                    (count strategy allocs :key #'strategy)))
-  (let ((temporaries (remove-if-not
-                      (lambda (a) (eql (strategy a) :temporary-variable))
-                      allocs)))
-    (format *debug-io* "Reused temporary variable slots: ~D~%"
-            (- (length temporaries)
-               (length (remove-duplicates temporaries :key #'varvec-index)))))
-  (terpri *debug-io*))
-
-(defun ci-compile-to-asm (iblock allocs)
-  (with-variable-allocations allocs
-    (compile-iblocks iblock)))
-
-(defun ci-asm-info (asm-obj)
-  (format *debug-io* "Final program length: ~D bytes.~%"
-          (length (compiled-bytes asm-obj)))
-  (terpri *debug-io*))
-
-(defun compile-string-to-bytes (string &key print-ir-p
-                                         return-tokens-p return-syntax-tree-p
-                                         return-iblock-p return-allocs-p
-                                         return-asm-p)
-  (let (tokens syntax-tree iblock allocs asm-obj bytes)
-    (format *debug-io* "Tokenizing...~%")
-    (setf tokens (ci-tokenize string))
-    (format *debug-io* "Done tokenizing.~%")
-    (ci-tokenize-info tokens)
-    
-    (format *debug-io* "Parsing...~%")
-    (setf syntax-tree (ci-parse tokens))
-    (format *debug-io* "Done parsing.~%")
-    (ci-parse-info syntax-tree)
-
-    (format *debug-io* "Compiling to IR...~%")
-    (setf iblock (ci-compile-to-ir syntax-tree))
-    (format *debug-io* "Done compiling to IR.~%")
-    (when (member print-ir-p '(:original :all))
-      (print-iblocks iblock))
-    (ci-ir-info iblock)
-
-    (format *debug-io* "Optimizing IR...~%")
-    (ci-optimize-ir iblock)
-    (format *debug-io* "Done optimizing IR.~%")
-    (when (member print-ir-p '(:optimized :all))
-      (print-iblocks iblock))
-    (ci-ir-info iblock)
-
-    (format *debug-io* "Pre-assembly preparations...~%")
-    (setf allocs (pre-assembly iblock))
-    (format *debug-io* "Done with pre-assembly preparations.~%")
-    (when (member print-ir-p '(:final :all t))
-      (print-iblocks iblock))
-    (ci-ir-info iblock)
-    (ci-allocation-info allocs)
-
-    (format *debug-io* "Compiling to machine language...~%")
-    (setf asm-obj (ci-compile-to-asm iblock allocs))
-    (setf bytes (compiled-bytes asm-obj))
-    (format *debug-io* "Done compiling to machine language.~%")
-    (ci-asm-info asm-obj)
-    (values
-     bytes
-     (append (when return-tokens-p (list :tokens tokens))
-             (when return-syntax-tree-p (list :syntax-tree syntax-tree))
-             (when return-iblock-p (list :iblock iblock))
-             (when return-allocs-p (list :allocs allocs))
-             (when return-asm-p (list :asm asm-obj))))))
-
-(defun batch-compile (input-filepath &optional output-filepath)
-  (usc-init)
-  (setf input-filepath (probe-file input-filepath))
-  (assert (pathnamep input-filepath))
-  (when (null output-filepath)
-    (setf output-filepath (make-pathname :name (pathname-name input-filepath)
-                                         :type "bin")))
-  (unless (string= "bin" (pathname-type output-filepath))
-    (format t "To avoid overwriting files incorrectly, output files must end in \".bin\".")
-    #-swank
-    (sb-ext:exit :code -1)
-    #+swank
-    (abort))
-  (assert (pathnamep output-filepath))
-  (handler-bind ((missing-function-error
-                   (lambda (c)
-                     (format t "Encountered unknown function \"~A\". Dummy created.~%"
-                             (first (format-arguments c)))
-                     (force-output)
-                     (continue c)))
-                 (usc-error
-                   (lambda (c)
-                     (format t "~A~%~%Error in batch mode, exiting.~%"
-                             c)
-                     #-swank
-                     (sb-ext:exit :code 65)
-                     #+swank
-                     (abort c)))
-                 (error
-                   (lambda (c)
-                     (format t "---- COMPILER BUG ----~%")
-                     (format t "An UNHANDLED error was encountered during compilation.~%~%")
-                     (trivial-backtrace:print-backtrace c)
-                     (format t "Please contact Duuqnd (duuqnd@stacken.kth.se).~%")
-                     #-swank
-                     (sb-ext:exit :code 70)
-                     #+swank
-                     (abort c))))
-    (let ((bytes (compile-string-to-bytes
-                  (uiop:read-file-string input-filepath))))
-      (with-open-file (stream output-filepath :direction :output
-                                              :element-type '(unsigned-byte 8)
-                                              :if-exists :supersede)
-        (loop :for byte :in bytes
-              :do (write-byte byte stream)))
-      (format t "Finished, wrote compiled program to \"~A\".~%"
-              output-filepath))))

wip-duuqnd/user-side-compiler/package.lisp

@@ -7,8 +7,4 @@
 (defpackage #:user-side-compiler
   (:nicknames #:usc)
   (:local-nicknames (#:tlk #:user-side-compiler/toolkit))
-  (:export #:usc-init #:compile-string-to-bytes
-           ;; Errors
-           #:usc-error #:tokenizer-error #:missing-function-error
-           #:parser-error))
   (:use #:cl))

wip-duuqnd/user-side-compiler/parser.lisp

@@ -7,6 +7,7 @@ parser's debug output.")
 ;;; Token stream
 
 (defvar *token-stream*)
+(defvar *token-comment* nil)
 
 (defun previous-token ()
   (cdr *token-stream*))
@@ -19,6 +20,9 @@ parser's debug output.")
       ((pop-token ()
          (setf (cdr *token-stream*) (pop (car *token-stream*)))
          (let ((got (previous-token)))
+           (if (comment-p (peek-token))
+               (setf *token-comment* (pop (car *token-stream*)))
+               (setf *token-comment* nil))
            got)))
     (cond ((and (keywordp token)
                 (typep (peek-token) 'token-keyword)
@@ -141,6 +145,7 @@ parser's debug output.")
                          (token-not 'node-expr-not)
                          (token-minus 'node-expr-negate))
                        :source *syntax-source*
+                       :comment *token-comment*
                        :operator-token (previous-token)
                        :operand (match-syntax primary))
         (match-syntax call))))
@@ -164,6 +169,7 @@ parser's debug output.")
 comma ',' is required to separate arguments.")))
          (make-instance 'node-call
                         :source *syntax-source*
+                        :comment *token-comment*
                         :callee (transform name 'asm-function)
                         :arguments arguments))
         (t name)))
@@ -178,6 +184,7 @@ comma ',' is required to separate arguments.")))
                           "Closing parenthesis ')' required after grouping expression.")
            (make-instance 'node-expr-grouping
                           :source *syntax-source*
+                          :comment *token-comment*
                           :expression expr)))
         ((match-token 'token-end-of-statement)
          (error-parser (source (previous-token))
@@ -194,6 +201,7 @@ comma ',' is required to separate arguments.")))
         (setf r-value (match-syntax expression))
         (make-instance 'node-assignment
                        :source *syntax-source*
+                       :comment *token-comment*
                        :variable (transform l-value 'reference-variable)
                        :value r-value))
       l-value))
@@ -216,10 +224,13 @@ comma ',' is required to separate arguments.")))
                            "End-of-statement required after FOR's THEN, got ~A"
                            (peek-token)))))
         ((match-token 'token-end-of-statement)
-         ;; Empty statement
+         ;; Empty statement, might contain comment
-         (make-instance 'node-nop :source *syntax-source*))
+         (make-instance 'node-nop
+                        :source *syntax-source*
+                        :comment *token-comment*))
         (t
          (let ((expr (match-syntax assignment)))
+           ;;(setf (comment expr) *token-comment*)
            (consume-token 'token-end-of-statement
                           (format nil "Couldn't find end of expression. ~A found instead."
                                   (peek-token)))
@@ -312,15 +323,16 @@ comma ',' is required to separate arguments.")))
                            (transform else 'node))))
 
 (define-syntax-matcher program (statements)
-  (loop :for statement := (match-syntax statement)
+  (let ((*token-comment* nil))
-        :unless (typep statement 'node-nop)
+    (loop :for statement := (match-syntax statement)
-          :do (push statement statements)
+          :unless (typep statement 'node-nop)
-        :until (null (peek-token)))
+            :do (push statement statements)
-  (setf statements (wire-up-statements (nreverse statements)))
+          :until (null (peek-token)))
-  (make-instance 'node-program
+    (setf statements (wire-up-statements (nreverse statements)))
-                 :source *syntax-source*
+    (make-instance 'node-program
-                 :statements statements
+                   :source *syntax-source*
-                 :next (first statements)))
+                   :statements statements
+                   :next (first statements))))
 
 ;;; Testing jigs
 

wip-duuqnd/user-side-compiler/test-programs.lisp

@@ -0,0 +1,22 @@
+(in-package #:user-side-compiler)
+
+(defun test-sweep ()
+  (let* ((line-routine (make-label :name "line" :address 0))
+         (var+=-routine (make-label :name "var+=" :address 0))
+         (var-=-routine (make-label :name "var-=" :address 0))
+         (calls (list (make-call line-routine '((t 0) (t 120) (nil 0) (nil 1)))
+                      (make-call line-routine '((t 255) (t 120) (nil 2) (nil 3)))
+                      (make-call var+=-routine '((nil 0) (t 1)))
+                      (make-call var+=-routine '((nil 1) (t 1)))
+                      (make-call var-=-routine '((nil 2) (t 1)))
+                      (make-call var-=-routine '((nil 3) (t 1))))))
+    (loop :with prev := nil
+          :for call :in calls
+          :unless (null prev)
+            :do (setf (next prev) call)
+          :do (setf prev call))
+    (let ((insts
+            (compile-starting-at
+             (make-instance 'node-dotimes :loopee-node (first calls) :stop-ref (make-instance 'reference-constant :value 240)))))
+      (fix-label-addresses-in-instruction-list insts #xc000)
+      (bytesquash-instruction-list insts #xc000))))

wip-duuqnd/user-side-compiler/tokenizer.lisp

@@ -63,12 +63,19 @@ reading immediately. Should be a subset of *SPECIAL-TOKEN-CHARS*.")
 (define-transformation (token (token-number integer))
   (value token))
 
+(defclass token-comment (token)
+  ((%text :accessor text :initarg :text)))
+
+(defmethod comment-p (obj)
+  nil)
+
+(defmethod comment-p ((obj token-comment))
+  t)
+
 ;; Special syntax tokens
 
-(defclass token-atomic (token) ())
-
 (defmacro define-atomic-token (name)
-  `(defclass ,name (token-atomic) ()))
+  `(defclass ,name (token) ()))
 
 (define-atomic-token token-end-of-statement)
 
@@ -136,6 +143,12 @@ reading immediately. Should be a subset of *SPECIAL-TOKEN-CHARS*.")
               ((member text *syntax-keywords* :test #'equalp)
                (make-instance 'token-keyword :source source
                               :name (intern (string-upcase text) (find-package '#:keyword))))
+              ((member (aref text 0) *line-comment-chars*)
+               (let ((start (position-if-not #'whitespacep (subseq text 1))))
+                 (make-instance 'token-comment
+                                :source source
+                                :text (if (null start) ""
+                                          (subseq text start)))))
               ((valid-name-p text)
                (make-instance 'token-name :source source :name text))
               (t (error 'tokenizer-error :source source :format-arguments (list text)
@@ -148,7 +161,7 @@ reading immediately. Should be a subset of *SPECIAL-TOKEN-CHARS*.")
         (in-comment-p nil)
         (line 1)
         (column 0)
-        (token-source (cons source (cons 1 0))))
+        (token-source (cons source 0)))
     (labels
         ((next-token ()
            (push (text-to-token (copy-seq token-text-buffer) token-source) tokens)
@@ -157,6 +170,7 @@ reading immediately. Should be a subset of *SPECIAL-TOKEN-CHARS*.")
                  token-source (cons source (cons line column)))))
       (loop :for char := (read-char stream)
             :for next := (peek-char nil stream nil :eof)
+            :do (incf column)
             :do
                (cond
                  ;; Break for next token at whitespace
@@ -175,7 +189,11 @@ reading immediately. Should be a subset of *SPECIAL-TOKEN-CHARS*.")
                  ((and (member char *line-comment-chars* :test #'char=) (not in-comment-p))
                   (unless (zerop (length token-text-buffer))
                     (next-token))
+                  (vector-push char token-text-buffer)
                   (setf in-comment-p t))
+                 ;; Comment character (next-token'd by newline)
+                 (in-comment-p
+                  (vector-push char token-text-buffer))
                  ;; Non-whitespace non-comment characters
                  ((and (not (whitespacep char)) (not in-comment-p))
                   (vector-push char token-text-buffer)
@@ -196,7 +214,6 @@ reading immediately. Should be a subset of *SPECIAL-TOKEN-CHARS*.")
                      (next-token))
                     ((eql :eof next)
                      (next-token)))))
-            :do (incf column)
             :until (eql :eof next)))
     (nreverse tokens)))
 

wip-duuqnd/user-side-compiler/user-side-compiler.asd

@@ -2,7 +2,7 @@
 
 (defsystem #:user-side-compiler
   :serial t
-  :depends-on (#:closer-mop #:alexandria #:trivial-backtrace)
+  :depends-on (#:closer-mop #:alexandria)
   :components
   ((:file "package")
    (:file "error-handling")
@@ -35,7 +35,4 @@
     :depends-on ("middle")
     :serial t
     :components ((:file "value-allocator")
-                 (:file "pre-assembly")
+                 (:file "code-generator")))))
-                 (:file "code-generator")))
-   (:file "interface")
-   (:file "binary-test-build")))