112 lines
4.4 KiB
Common Lisp
112 lines
4.4 KiB
Common Lisp
(in-package #:user-side-compiler)
|
|
|
|
(defun get-line-comment (line)
|
|
(unless (zerop (length line))
|
|
(let ((index
|
|
(loop :with got-it-p := nil
|
|
:for index :from 0
|
|
:for char := (char line index)
|
|
:when (char= char #\;)
|
|
:do (setf got-it-p t)
|
|
:until (or (and got-it-p (char/= char #\;))
|
|
(= (1+ index) (length line)))
|
|
:finally (return
|
|
(if (= (1+ index) (length line))
|
|
nil
|
|
index)))))
|
|
(unless (null index)
|
|
(subseq line index)))))
|
|
|
|
(defun parse-asm-label (string)
|
|
(flet
|
|
((name-char-p (char)
|
|
(or (alphanumericp char) (char= char #\_))))
|
|
(cond
|
|
((zerop (length string))
|
|
nil)
|
|
;; if it's an assembler macro, check that it's .proc
|
|
((and (char= (char string 0) #\.)
|
|
(string-equal (subseq string 0 5) ".proc")
|
|
(whitespacep (char string 5)))
|
|
(let* ((start (position-if-not #'whitespacep string :start 5))
|
|
(end (position-if-not #'name-char-p string :start start)))
|
|
(subseq string start end)))
|
|
;; Regular colon label (ROUTINE_NAME:)
|
|
((loop :for char :across string
|
|
:until (char= char #\:)
|
|
:always (name-char-p char))
|
|
(subseq string 0 (position #\: string))))))
|
|
|
|
(defun asm-declaration-p (string)
|
|
(let ((comment (get-line-comment string))
|
|
(label (parse-asm-label string)))
|
|
(and (search "user-procedure" comment :test #'char-equal) label)))
|
|
|
|
(defun parse-asm-declaration (string)
|
|
(assert (asm-declaration-p string))
|
|
(let ((routine-name (parse-asm-label string))
|
|
(declaration (get-line-comment string)))
|
|
(with-input-from-string (input declaration)
|
|
(list routine-name
|
|
(let ((*read-eval* nil)
|
|
(eof '#.(gensym)))
|
|
(loop :for obj := (read input nil eof)
|
|
:until (eql obj eof)
|
|
:collect obj))))))
|
|
|
|
(defun find-declarations-in-listing (filepath)
|
|
(with-open-file (stream filepath)
|
|
(loop :for line := (read-line stream)
|
|
:until (and (not (zerop (length line)))
|
|
(digit-char-p (char line 0))))
|
|
(loop :for line := (read-line stream nil :eof)
|
|
:until (eql line :eof)
|
|
:for address := (parse-integer line :start 0 :end 6 :radix 16)
|
|
:for main-text := (subseq line 24)
|
|
:when (asm-declaration-p main-text)
|
|
:collect (destructuring-bind (name declaration)
|
|
(parse-asm-declaration main-text)
|
|
(list name address declaration)))))
|
|
|
|
(defparameter *program-listing-filepath* #P"../../wip-hugo/program.lst")
|
|
(defparameter *program-build-filepath* #P"../../wip-hugo/build.sh")
|
|
|
|
(defun check-for-asm-build-script ()
|
|
(do ((path *program-build-filepath*))
|
|
((probe-file path) path)
|
|
(restart-case
|
|
(error "Couldn't find assembly build script ~S." path)
|
|
(use-value (filepath)
|
|
:report "Specify a different path to the build script."
|
|
:interactive (lambda ()
|
|
(format t "Enter new pathname (evaled): ")
|
|
(eval (read)))
|
|
(setf path filepath)))))
|
|
|
|
(defun build-assembly-program ()
|
|
(let ((script-path (check-for-asm-build-script))
|
|
(current-dir (uiop:getcwd)))
|
|
(unwind-protect
|
|
(progn
|
|
(uiop:chdir (make-pathname :defaults script-path
|
|
:name nil :type nil))
|
|
(uiop:run-program (namestring
|
|
(make-pathname :defaults script-path
|
|
:directory '(:relative ".")))))
|
|
(uiop:chdir current-dir))))
|
|
|
|
(defun check-for-assembly-listing ()
|
|
(do ((listing *program-listing-filepath*))
|
|
((probe-file listing) listing)
|
|
(restart-case
|
|
(error "Couldn't find assembly listing ~S." listing)
|
|
(build-program ()
|
|
:report "Build the assembly program to generate listing."
|
|
(build-assembly-program)))))
|
|
|
|
(defun populate-asm-functions ()
|
|
(let* ((listing (check-for-assembly-listing))
|
|
(routine-info (find-declarations-in-listing listing)))
|
|
(loop :for (name address declaration) :in routine-info
|
|
;; TODO: Use declaration info
|
|
:do (add-asm-function name address))))
|