47 lines
1.5 KiB
Common Lisp
47 lines
1.5 KiB
Common Lisp
(in-package #:user-side-compiler)
|
|
|
|
(defclass label ()
|
|
((%name :accessor name :initarg :name)
|
|
(%address :accessor address :initform nil :initarg :address)))
|
|
|
|
(defun labelp (obj)
|
|
(typep obj 'label))
|
|
|
|
(defmethod print-object ((object label) stream)
|
|
(with-accessors ((name name) (address address)) object
|
|
(print-unreadable-object (object stream :type t)
|
|
(write-string name stream)
|
|
(unless (null address)
|
|
(format stream " @ 0x~4,'0X" address)))))
|
|
|
|
(defvar *label-counter* 0)
|
|
|
|
(defun make-label-name (prefix)
|
|
(format nil "~A~D" prefix (incf *label-counter*)))
|
|
|
|
(defun make-label (&key name name-prefix address)
|
|
(when (and (not (null name)) (not (null name-prefix)))
|
|
(warn "MAKE-LABEL with both name (~A) and prefix (~A) specified (useless)."
|
|
name name-prefix))
|
|
(when (null name)
|
|
(setf name (make-label-name (if (null name-prefix) "L" name-prefix))))
|
|
(make-instance 'label :name name :address address))
|
|
|
|
(defclass offset-label (label)
|
|
((%offset-from :accessor offset-from :initarg :offset-from)
|
|
(%offset :accessor offset :initarg :offset)))
|
|
|
|
(defmethod address ((object offset-label))
|
|
(+ (address (offset-from object))
|
|
(offset object)))
|
|
|
|
(defmethod name ((object offset-label))
|
|
(format nil "~A~C~D"
|
|
(name (offset-from object))
|
|
(if (minusp (offset object))
|
|
#\-
|
|
#\+)
|
|
(offset object)))
|
|
|
|
(defun make-offset-label (src-label offset)
|
|
(make-instance 'offset-label :offset-from src-label :offset offset))
|