Add way to make binary test build of user-side compiler

.gitignore

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

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

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

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

@@ -144,9 +144,6 @@ 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))
 
@@ -365,36 +362,3 @@ 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

@@ -0,0 +1,64 @@
+(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,21 +27,6 @@
    (%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)
@@ -91,21 +76,3 @@
       (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

@@ -0,0 +1,32 @@
+(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,10 +36,13 @@
                      (point-out-source (source c))))))
 
 (define-condition tokenizer-error (usc-error)
-  ((%context-string :initform "Error in tokenizer:")))
+  ((%context-string :initform "Tokenizing error:")))
+
+(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

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

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

@@ -0,0 +1,204 @@
+(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,4 +7,8 @@
 (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,7 +7,6 @@ parser's debug output.")
 ;;; Token stream
 
 (defvar *token-stream*)
-(defvar *token-comment* nil)
 
 (defun previous-token ()
   (cdr *token-stream*))
@@ -20,9 +19,6 @@ 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)
@@ -145,7 +141,6 @@ 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))))
@@ -169,7 +164,6 @@ 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)))
@@ -184,7 +178,6 @@ 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))
@@ -201,7 +194,6 @@ 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))
@@ -224,13 +216,10 @@ 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, might contain comment
+         ;; Empty statement
-         (make-instance 'node-nop
+         (make-instance 'node-nop :source *syntax-source*))
-                        :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)))
@@ -323,7 +312,6 @@ comma ',' is required to separate arguments.")))
                            (transform else 'node))))
 
 (define-syntax-matcher program (statements)
-  (let ((*token-comment* nil))
   (loop :for statement := (match-syntax statement)
         :unless (typep statement 'node-nop)
           :do (push statement statements)
@@ -332,7 +320,7 @@ comma ',' is required to separate arguments.")))
   (make-instance 'node-program
                  :source *syntax-source*
                  :statements statements
-                   :next (first statements))))
+                 :next (first statements)))
 
 ;;; Testing jigs
 

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

@@ -1,22 +0,0 @@
-(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,19 +63,12 @@ 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) ()))
+  `(defclass ,name (token-atomic) ()))
 
 (define-atomic-token token-end-of-statement)
 
@@ -143,12 +136,6 @@ 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)
@@ -161,7 +148,7 @@ reading immediately. Should be a subset of *SPECIAL-TOKEN-CHARS*.")
         (in-comment-p nil)
         (line 1)
         (column 0)
-        (token-source (cons source 0)))
+        (token-source (cons source (cons 1 0))))
     (labels
         ((next-token ()
            (push (text-to-token (copy-seq token-text-buffer) token-source) tokens)
@@ -170,7 +157,6 @@ 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
@@ -189,11 +175,7 @@ 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)
@@ -214,6 +196,7 @@ 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)
+  :depends-on (#:closer-mop #:alexandria #:trivial-backtrace)
   :components
   ((:file "package")
    (:file "error-handling")
@@ -35,4 +35,7 @@
     :depends-on ("middle")
     :serial t
     :components ((:file "value-allocator")
-                 (:file "code-generator")))))
+                 (:file "pre-assembly")
+                 (:file "code-generator")))
+   (:file "interface")
+   (:file "binary-test-build")))