Improve test binary stuff

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

@@ -1,31 +1,67 @@
 (in-package #:user-side-compiler)
 
+(defparameter *batch-arguments*
+  '(("-o" "--output" " <file>" "Output generated code into <file>." :output)
+    (nil "--print-ir" " <final|all|original|optimized>" "Print specified IR instructions.")
+    ("-h" "--help" "" "Display this help message." :show-help-p)
+    ("-v" "--version" "" "Display the program's version." :show-version-p)))
+
 (defun batch-parse-options (arguments)
   (let ((options '()))
-    (loop :with outputp := nil
+    (loop :with option := nil
           :for arg :in arguments
-          :do (cond (outputp
+          :do (cond (option
-                     (setf (getf options :output) arg
+                     (setf (getf options option) arg
-                           outputp nil))
+                           option nil))
-                    ((or (string= arg "-o") (string= arg "--output"))
+                    ((and (char/= (char arg 0) #\-)
-                     (setf outputp t))
+                          (null (getf options :input)))
-                    ((or (string= arg "-h") (string= arg "--help"))
+                     (setf (getf options :input) arg))
-                     (setf (getf options :show-help-p) t))
+                    ((char= (char arg 0) #\-)
+                     (let ((option-definition
+                             (or (find arg *batch-arguments* :key #'first
+                                                             :test #'string=)
+                                 (find arg *batch-arguments* :key #'second
+                                                             :test #'string=))))
+                       (if option-definition
+                           (setf option (fifth option-definition))
+                           (progn
+                             (format t "Unknown option \"~A\"~%" arg)
+                             (setf (getf options :show-help-p) t)))))
                     (t
-                     (setf (getf options :input) arg))))
+                     (setf (getf options :show-help-p) t)
+                     (loop-finish))))
     options))
 
+(defun batch-help ()
+  (format t "Usage: c6lc [options] <input file>~%")
+  (format t "Options:~%")
+  (loop :for (short long post message key)
+          :in *batch-arguments*
+        :do (if (null short)
+                (format t "~A~A~44T~A~%" long post message)
+                (format t "~A~A / ~A~A~44T~A~%" short post long post message))))
+
+(defun batch-version ()
+  (format t "Using c6lc v~A~%"
+          #.(asdf:component-version (asdf:find-system '#:user-side-compiler))))
+
 (defun batch-main ()
-  (destructuring-bind (&key input output show-help-p)
+  (destructuring-bind (&key input output show-help-p show-version-p)
       (batch-parse-options (uiop:command-line-arguments))
-    (if show-help-p
+    (cond ((or show-help-p
-        (progn
+               (every #'null (list input output show-help-p show-version-p)))
-          (format t "Usage: c6lc [-o <output file>] <input file>~%")
+           (batch-help))
-          (sb-ext:exit :code -1))
+          (show-version-p
-        (batch-compile input output))))
+           (batch-version))
+          (t
+           (restart-case
+               (batch-compile input output)
+             (abort ()
+               (sb-ext:exit :code -1)))))))
 
 (defun build ()
   (assert (not (member :swank *features*)))
+  (usc-init)
   (sb-ext:save-lisp-and-die "c6lc" :toplevel #'batch-main :executable t
                                    :save-runtime-options t
                                    :root-structures 'batch-main

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

@@ -155,20 +155,26 @@
              (when return-allocs-p (list :allocs allocs))
              (when return-asm-p (list :asm asm-obj))))))
 
-(defun batch-compile (input-filepath &optional output-filepath)
+(defun batch-compile (input-filepath output-filepath &rest compile-args)
-  (usc-init)
+  (when (null input-filepath)
-  (setf input-filepath (probe-file input-filepath))
+    (format t "Missing path to input source file.~%")
-  (assert (pathnamep input-filepath))
+    (abort))
   (when (null output-filepath)
     (setf output-filepath (make-pathname :name (pathname-name input-filepath)
                                          :type "bin")))
-  (unless (string= "bin" (pathname-type output-filepath))
+  (setf output-filepath
-    (format t "To avoid overwriting files incorrectly, output files must end in \".bin\".")
+        (parse-namestring output-filepath nil
+                          *default-pathname-defaults*
+                          :junk-allowed t))
+  (when (null output-filepath)
+    (setf output-filepath (make-pathname :name (pathname-name input-filepath)
+                                         :type "bin")))
+  (unless (equal "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.~%"
@@ -183,18 +189,28 @@
                      (sb-ext:exit :code 65)
                      #+swank
                      (abort c)))
+                 (file-error
+                   (lambda (c)
+                     (format t "~A~%" c)
+                     (abort c)))
+                 (sb-int:stream-decoding-error
+                   (lambda (c)
+                     (format t "Tried to read text from a file which is not UTF-8.~%~%~A~%" c)
+                     (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).~%")
+                     (format t "You may be elligible to win one (1) item from Stackomaten!~%")
+                     (format t "Please send this whole output text to duuqnd@stacken.kth.se to claim your prize.~%")
                      #-swank
                      (sb-ext:exit :code 70)
                      #+swank
                      (abort c))))
-    (let ((bytes (compile-string-to-bytes
+    (let ((bytes (apply #'compile-string-to-bytes
-                  (uiop:read-file-string input-filepath))))
+                        (uiop:read-file-string input-filepath)
+                        compile-args)))
       (with-open-file (stream output-filepath :direction :output
                                               :element-type '(unsigned-byte 8)
                                               :if-exists :supersede)

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

@@ -2,6 +2,7 @@
 
 (defsystem #:user-side-compiler
   :serial t
+  :version "0.1.0"
   :depends-on (#:closer-mop #:alexandria #:trivial-backtrace)
   :in-order-to ((asdf:test-op (asdf:test-op #:user-side-compiler/test)))
   :components