(herald (assembler as_syntax t 54))

;;; Declarations for AS clients - i.e.  machine descriptions.  AS also
;;; provides and interface for use by the code generator.  That interface
;;; is partially described by the file AS.T; and partially described by the
;;; particular machine description being used.  

;;;;;;;; let's trust our loading sequence.   -rm                                                                              
;(require (assembler compile_fgs))
;(require (assembler as_utils))

;;; ----------------------------------------------------------------
;;; An FG-TEMPLATE expression yields a procedure which (when called
;;;  with the appropriate arguments) yields an FG of the form
;;;  described by the template

(define-syntax (fg-template bvl . specs)
  `(fg-type-constructor ,(process-fg-definition (car bvl) (cdr bvl) specs)))

(define-syntax (define-fg bvl . specs)
  `(define ,(car bvl) (fg-template ,bvl . ,specs)))

(define-syntax (define-data-fg bvl . specs)
  `(let ((type ,(process-fg-definition (car bvl) (cdr bvl) specs)))
     (set (fg-type-data? type) '#t)
     (define ,(car bvl) (fg-type-constructor type))))

(define-syntax (define-w/?-fg bvl . specs)
  `(let ((type ,(process-fg-definition (car bvl) (cdr bvl) specs)))
     (define ,(car bvl) (fg-type-constructor type))
     (define ,(concatenate-symbol (car bvl) "-FG?")
       (make-fg-predicator type))))

(define-syntax (define-fg-op machine bvl index . specs)
  `(block
    (define-constant ,(concatenate-symbol '% machine '% (car bvl)) ,index)
    (*define-op ,machine ,index ',(car bvl) (fg-template ,bvl . ,specs))))

(define-syntax (define-op machine bvl index . body)
  (receive (name body)
           (cond ((pair? bvl)
                  (return (car bvl) `(lambda ,(cdr bvl) . ,body)))
                 (else
                  (return bvl (car body))))
    `(block
      (define-constant ,(concatenate-symbol '% machine '% name) ,index)
      (*define-op ,machine ,index ',name ,body))))

;;; Code generator should use something like this to access machine ops

(define-syntax (machine-operation machine opname)
  `(vref (machine-ops-vector ,machine)
         ,(concatenate-symbol '% machine '% opname)))

;;; ----------------------------------------------------------------

;;; Pseudo op definition

;;; Pseudo-ops are called by the lap processor on the form, the assembly
;;; section, and the current ib.  Pseudo-operands are called on the form and the
;;; assembly section.  These macros provide procedures which ignore everything
;;; but the form, and destructure the form into the components in the bvl.

;;; Pseudo ops can return an ib that will be used as the current ib.

(define-syntax (pseudo-op bvl . body)
  (let ((form-name (generate-symbol '%form)))
    `(lambda (,form-name () ())
       (destructure ((,bvl (cdr ,form-name))) ,@body))))

(define-syntax (pseudo-operand bvl . body)
  (let ((form-name (generate-symbol '%form)))
    `(lambda (,form-name ())
       (destructure ((,bvl (cdr ,form-name))) ,@body))))

(define-syntax (define-global-lap-macro machine bvl . body)
  (let ((name (car bvl)))
    `(*define-pseudo-global ,machine ',name
                            (lambda (form sec ib)
                              (destructure ((,bvl form))
                                (process-lap-list ,@body sec ib))))))