symbol-table.lisp

   1 (in-package :m68k-assembler)
   2
   3 ;;;; SYMBOL TABLE
   4
   5 (defvar *symbol-table* nil)
   6
   7 (defstruct asm-symbol
   8   (name)
   9   (type)
  10   (value)
  11   (debug-info)
  12   (global-p nil))
  13
  14 (defun local-label-name-p (name)
  15   (and (> (length name) 1) (eql (char name 0) #\.)))
  16
  17 (defun sacred-name-of-pc-p (name)
  18   (and (= (length name) 1) (eql (char name 0) #\.)))
  19
  20 (defun maybe-local-label (name last-label)
  21   (if (local-label-name-p name)
  22       (concatenate 'string last-label name)
  23       name))
  24
  25 (defun wipe-symbol-table ()
  26   (setf *symbol-table* (make-hash-table :test #'equalp)))
  27
  28 (defun add-to-symbol-table (sym value
  29                             &key (type (section-name *current-section*))
  30                             (global-p nil))
  31   (let ((name (extract-sym-name sym)))
  32     (setf (gethash name *symbol-table*)
  33           (make-asm-symbol :name name
  34                            :type type
  35                            :value value
  36                            :debug-info *source-position*
  37                            :global-p global-p))))
  38
  39 (defun get-symbol-value (sym)
  40   (awhen (get-asm-symbol sym) (asm-symbol-value it)))
  41
  42 (defun (setf get-symbol-value) (value sym)
  43   (setf (asm-symbol-value (get-asm-symbol sym)) value))
  44
  45 (defun get-symbol-type (sym)
  46   (awhen (get-asm-symbol sym) (asm-symbol-type it)))
  47
  48 (defun get-asm-symbol (sym)
  49   (setf sym (extract-sym-name sym))
  50   (if (sacred-name-of-pc-p sym)
  51       (make-asm-symbol :name "."
  52                        :value *program-counter*
  53                        :type (section-name *current-section*))
  54       (gethash sym *symbol-table*)))
  55
  56 (defun extract-sym-name (sym)
  57   (let ((name (cond ((atom sym) sym)
  58                     ((or (eql (car sym) 'absolute)
  59                          (eql (car sym) 'label))
  60                      (second (second sym)))
  61                     (t (second sym)))))
  62     (maybe-local-label name *last-label*)))
  63
  64 (defun define-extern (label op operands modifier)
  65   (declare (ignore op modifier))
  66   ;; add whatever to the symbol table, as an extern
  67   (handle-label-normally label)
  68   (dolist (x operands)
  69     (let ((name (extract-string-from-tree x)))
  70       (add-to-symbol-table name 0 :type 'extern :global-p t))))
  71
  72 (defun define-global (label op operands modifier)
  73   (declare (ignore op modifier))
  74   ;; add whatever to the symbol table, or just tweak
  75   ;; its type if necessary.
  76   (handle-label-normally label)
  77   (dolist (x operands)
  78     (let ((name (extract-string-from-tree x)))
  79       (aif (get-asm-symbol name)
  80            (setf (asm-symbol-global-p it) t) ; XXX hope this works.
  81            (add-to-symbol-table name nil :global-p t)))))
  82
  83 (defun serialize-symbol-table ()
  84   (let ((table (make-array (list 0) :adjustable t :fill-pointer 0)))
  85     (maphash (lambda (k v)
  86                (declare (ignore k))
  87                (when (asm-symbol-global-p v)
  88                  (vector-push-extend v table)))
  89              *symbol-table*)
  90     table))