Stacken/c64-livecoding
6
0
Fork 0
Code Issues 1 Pull requests Projects Releases Packages Wiki Activity Actions

Improve test binary stuff

Browse source
This commit is contained in:
John Lorentzson 2025-07-10 17:41:37 +02:00
parent 385ae9c9e6
commit fd70c8d5dc
3 changed files with 78 additions and 25 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -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
(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))
:do (cond (option
(setf (getf options option) arg
option nil))
((and (char/= (char arg 0) #\-)
(null (getf options :input)))
(setf (getf options :input) arg))
((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
(progn
(format t "Usage: c6lc [-o <output file>] <input file>~%")
(sb-ext:exit :code -1))
(batch-compile input output))))
(cond ((or show-help-p
(every #'null (list input output show-help-p show-version-p)))
(batch-help))
(show-version-p
(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

36
wip-duuqnd/user-side-compiler/interface.lisp
View file

@ -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)
(usc-init)
(setf input-filepath (probe-file input-filepath))
(assert (pathnamep input-filepath))
(defun batch-compile (input-filepath output-filepath &rest compile-args)
(when (null input-filepath)
(format t "Missing path to input source file.~%")
(abort))
(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\".")
(setf output-filepath
(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
(uiop:read-file-string input-filepath))))
(let ((bytes (apply #'compile-string-to-bytes
(uiop:read-file-string input-filepath)
compile-args)))
(with-open-file (stream output-filepath :direction :output
:element-type '(unsigned-byte 8)
:if-exists :supersede)

1
wip-duuqnd/user-side-compiler/user-side-compiler.asd
View file

@ -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