(herald (assembler as_open t 11))

;;; ---------------- Target machine parameters

;;; A filled-in machine structure is created by each set of machine
;;; dependent files.
                                                               
(define-structure-type machine
  uncond-branch    ; FG generators for [un]conditional branches, for the
  cond-branch      ; .. branchifier (change branches to jumps and fall throughs)
  reverse-jump     ; routine to reverse jump-ops

  clump-size       ; 8 for Vax, 16 for 68000
  maximum-clumps   ; 4 for vax  5 or 7 for 68000, max number of pending clumps.
  clump-writer     ; routine to write a clump, see BITS
;  bits-writer      ; routine to write a field, see BITS

  pseudo-ops       ; ... alist of procedures called while processing lap
  pseudo-operands  ; ... ...
  ops-table        ; table, operation name -> conser
  ops-vector

  coerce-lap-reg   ; when an operand in lap is a fixnum, this is called on it
  )             

(define-integrable machine-lap-env machine-ops-table)

(define (cons-machine op-count clump-size max-clumps reg-coercer cw) ;low-first?
  (let ((m (make-machine)))
    (set (machine-clump-size m) clump-size)
    (set (machine-maximum-clumps m) max-clumps)
    (set (machine-pseudo-ops m) (make-table `(machine-pseudo-ops ,m)))
    (set (machine-pseudo-operands m) (make-table `(machine-pseudo-operands ,m)))
    (set (machine-ops-table m) (make-table `(machine-ops-table ,m)))
    (set (machine-ops-vector m) (make-vector op-count))
    (set (machine-coerce-lap-reg m) reg-coercer)
    (set (machine-clump-writer m) cw)
;    (set (machine-bits-writer m)
;        (if low-first? write-bits-low-first write-bits-high-first))
    m))

(define (*define-op machine index op-name constructor)
  (set (vref (machine-ops-vector machine) index) constructor)
  (set (table-entry (machine-ops-table machine) op-name) constructor))

;;; ---------------- Assembly sections

;;; Each contiguous sequence of bits is represented by a section structure.
;;; (so we can assembly a data section and text section, say - there is
;;; currently no support for addressing between sections, but the
;;; necessary support from the linker would be easy to add) 

;;; The assembler uses IBs as labels (but calls them 'tags').  The user
;;; interface allows anything to be used as a label, by maintaining a table
;;; that maps them into IBs.  A section also keeps track of the target
;;; machine, and the ibs involved.  

(define-structure-type assembly-section
  machine
  ibs                                   ; list of all ibs for this section
  labels                                ; table of labels for this section
  ib-vector
  bits
  globals                               ; list of global labels
  stats                                 ; s-expression of assembly statistics
  )

(define (cons-assembly-section machine)
  (let ((a (make-assembly-section)))
    (set (assembly-section-machine a) machine)
    (set (assembly-section-ibs a) '())
    (set (assembly-section-labels a) (make-table))
    (set (assembly-section-globals a) '())
    a))

;;; ---------------- Field size utilities

;;; The assembler itself uses these, but machine descriptions
;;; may also make use of them.

(define-integrable (fx-lessp x y z)
  (and (fixnum? y) (fx<= x y) (fx< y z)))

(define-integrable (4bit? n)
  (fx-lessp -8 n 8))

(define-integrable (7bit? n)
  (fx-lessp -64 n 64))

(define-integrable (7bit-in-bits? n)
  (fx-lessp -512 n 512))

(define-integrable (8bit? n)
  (fx-lessp -128 n 128))

(define-integrable (8bit-in-bits? n)
  (fx-lessp -1024 n 1024))

(define-integrable (14bit? n)
  (fx-lessp #x-2000 n #x2000))

(define-integrable (14bit-in-bits? n)
  (fx-lessp #x-10000 n #x10000))

(define-integrable (16bit? n)
  (fx-lessp #x-8000 n #x8000))

(define-integrable (16bit-in-bits? n)
  (fx-lessp #x-40000 n #x40000))

(define-integrable (4bit-u? n)
  (fx-lessp -1 n #x10))

(define-integrable (8bit-u? n)
  (fx-lessp -1 n #x100))

(define-integrable (16bit-u? n)
  (fx-lessp -1 n #x10000))

(define-integrable (bit-mask width)
  (fx-not (fx-ashl -1 width)))

(define-integrable (fixnum-of-bits? bits)
  (lambda (obj)
    (and (fixnum? obj)
         (fx<= obj (bit-mask bits))
         (fx< (fx-ashl -1 bits) obj))))

;;; Used in listing, & in bits.

(define-integrable (fixnum-floor x y)
  (fx- x (fixnum-mod x y)))

(define-integrable (fixnum-ceiling x y)
  (fixnum-floor (fx+ x (fx- y 1)) y))

(define-integrable (fixnum-maximum x y)
  (if (fx> x y) x y))

;;; TRC randomness

(define-integrable (id->string id)
  (string-downcase! (symbol->string id)))