; mword : size of a word in data memory
; maddr : addr bits of data memory (size of memory = 2^maddr)
; pt : number of bits for program counter (size of instruction memory = 2^pt)
; op : number of optode bits (for all the cases op = 2)
; ptcbuf : size of internal buffer 
; We assume that pt > ptcbuf (I should modify it to allow pt = ptcbuf as well)


; Helper functions
(setf *print-pretty* t)
(defvar *bat2aig* "bat2aig")
(defvar *cnf2aig* "cnf2aig")
(defvar *bat2cnf* "bat2cnf")

(defun mashup-symbol (&rest objects)
  (intern (format nil "~{~a~}" objects)))

(defun make-unsigned (n)
  (mashup-symbol n 'u))

(defun unroll-impl-next-mem-aux (n msz mword sks)
  (if (= n 1)
      (if sks
          `((nmem0
            (impl-next-mem mem (gcmdimpl cbuf ,(make-unsigned 0)))))
        `((((nmem0 ,msz ,mword))
           (impl-next-mem mem (gcmdimpl cbuf ,(make-unsigned 0))))))
    (let ((loc (make-unsigned (- n 1)))
          (nmem (mashup-symbol 'nmem (- n 1)))
          (nmemp (mashup-symbol 'nmem (- n 2))))
      (cons 
       (if sks
           `(,nmem
             (impl-next-mem ,nmemp (gcmdimpl cbuf ,loc)))
         `(((,nmem ,msz ,mword))
           (impl-next-mem ,nmemp (gcmdimpl cbuf ,loc))))
       (unroll-impl-next-mem-aux (- n 1) msz mword sks)))))

(defun unroll-impl-next-mem (n msz mword sks)
  (let ((loc (make-unsigned n)))
    `((= ptcbuf ,loc)
       (local ,(reverse (unroll-impl-next-mem-aux n msz mword sks)) ,(mashup-symbol 'nmem (- n 1))))))

(defun impl-observable-mem-step-body-aux (n msz mword sks)
  (if (= n 0)
      `(((= ptcbuf ,(make-unsigned n))
         mem))
    (cons (unroll-impl-next-mem n msz mword sks)
          (impl-observable-mem-step-body-aux (- n 1) msz mword sks))))

(defun impl-observable-mem-step-body (n msz mword sks)
  (cons 'cond (reverse (append '((0b1 mem))
                               (impl-observable-mem-step-body-aux n msz mword sks)))))

(defun zero-padding (n)
  (if (= n 0)
      nil
    (cons '0b0 (zero-padding (- n 1)))))

(defun match-bit-width (ptsz ptbufsz vname)
  (if (< ptsz ptbufsz)
      (format t "Imem size is smaller than cbuf size")
    (if (= ptsz ptbufsz)
        vname
      (cons 'cat (append (zero-padding (- ptsz ptbufsz)) (list 'ptcbuf))))))

(defun unroll-impl-step-aux (n)
  (if (<= n 0)
      nil
    (if (= n 1)
        '(((cmds1 pt1 mem1 cbuf1 ptcbuf1 done1 cmds-done1)
           (impl-step cmds cpt mem cbuf 0u done ccmds-done)))
      (let* ((pn (- n 1))
             (pcmds (mashup-symbol 'cmds pn))
             (ppt (mashup-symbol 'pt pn))
             (pmem (mashup-symbol 'mem pn))
             (pcbuf (mashup-symbol 'cbuf pn))
             (pptcbuf (mashup-symbol 'ptcbuf pn))
             (pdone (mashup-symbol 'done pn))
             (pcmds-done (mashup-symbol 'cmds-done pn))
             (ccmds (mashup-symbol 'cmds n))
             (cpt (mashup-symbol 'pt n))
             (cmem (mashup-symbol 'mem n))
             (ccbuf (mashup-symbol 'cbuf n))
             (cptcbuf (mashup-symbol 'ptcbuf n))
             (cdone (mashup-symbol 'done n))
             (ccmds-done (mashup-symbol 'cmds-done n)))
        (cons `((,ccmds ,cpt ,cmem ,ccbuf ,cptcbuf ,cdone ,ccmds-done)
                 (impl-step ,pcmds ,ppt ,pmem ,pcbuf ,pptcbuf ,pdone ,pcmds-done))
              (unroll-impl-step-aux (- n 1)))))))
  
(defun unroll-impl-step (n)
  (reverse (unroll-impl-step-aux n)))


(defun compare-state-from-committed-state-aux (n)
  (if (= n 0)
       '(((= ptcbuf 0u)
         0b1))
    (let ((ncmds (mashup-symbol 'cmds n))
          (npt (mashup-symbol 'pt n))
          (nmem (mashup-symbol 'mem n))
          (nptcbuf (mashup-symbol 'ptcbuf n))
          (ncbuf (mashup-symbol 'cbuf n))
          (ncmds-done (mashup-symbol 'cmds-done n))
          (ndone (mashup-symbol 'done n)))
      (cons `((= ptcbuf ,(make-unsigned n))
              (and (= ,ncmds cmds)
              (= ,npt pt)
              (= ,nmem mem)
              (= ,nptcbuf ptcbuf)
              (= ,ncbuf cbuf)
              (= ,ncmds-done cmds-done)
              (= ,ndone done)))
            (compare-state-from-committed-state-aux (- n 1))))))

(defun compare-state-from-committed-state (n)
  (reverse (compare-state-from-committed-state-aux n)))

(defun compare-impl-and-spec-state-aux (n)
  (if (= n 0)
      nil
    (let ((smem (mashup-symbol 'smem n))
          (spt (mashup-symbol 'spt n))
          (sdone (mashup-symbol 'sdone n)))
      (cons `(and (= nimem ,smem)
                  (= nript ,spt)
                  (= nidone ,sdone))
            (compare-impl-and-spec-state-aux (- n 1))))))

(defun compare-impl-and-spec-state (n)
  (reverse (compare-impl-and-spec-state-aux n)))


(defun unroll-spec-step-aux (n)
  (if (= n 1)
      '(((scmds1 spt1 smem1 sdone1)
         (spec-step cmds spt smem sdone)))
    (let* ((scmds (mashup-symbol 'scmds n))
          (spt (mashup-symbol 'spt n))
          (smem (mashup-symbol 'smem n))
          (sdone (mashup-symbol 'sdone n))
          (pn (- n 1))
          (pscmds (mashup-symbol 'scmds pn))
          (pspt (mashup-symbol 'spt pn))
          (psmem (mashup-symbol 'smem pn))
          (psdone (mashup-symbol 'sdone pn)))
      (cons `((,scmds ,spt ,smem ,sdone)
              (spec-step ,pscmds ,pspt ,psmem ,psdone))
            (unroll-spec-step-aux (- n 1))))))

(defun unroll-spec-step (n)
  (reverse (unroll-spec-step-aux n)))

(defun print-to-file (l name)
  (with-open-file (stream name :direction :output 
                          :if-exists :overwrite
                          :if-does-not-exist   :create)
    (dolist (item l) (write-line (format nil "~(~A~)" item) stream))))


;; functions common to both specification and implementation 
;; operations on memory (read,write,refresh)
(defun core-functions (op mword maddr ptsz)
  (let* ((msz (expt 2 maddr))
         (cmdsz (+ op mword maddr))
         (isz (expt 2 ptsz))
         (op-lo 0)
         (op-hi (- (+ op-lo op) 1)) 
         (val-lo (+ op-hi 1)) 
         (val-hi (- (+ val-lo mword) 1)) 
         (addr-lo (+ val-hi 1)) 
         (addr-hi (- (+ addr-lo maddr) 1))) 
    `(
      (mwrite ((,msz ,mword) (,mword))
              ((mem ,msz ,mword) (v ,mword) (addr ,maddr))
              (mv (set mem addr v) v))
      
      (mread ((,msz ,mword) (,mword))
             ((mem ,msz ,mword) (addr ,maddr))
             (mv mem (get mem addr)))
      
      (mrefresh ((,msz ,mword) (,mword))
                ((mem ,msz ,mword) (addr ,maddr))
                (mv mem 0u))

      (gop (,op) ((cmd ,cmdsz))
           (bits cmd ,op-lo ,op-hi))
      
      (gval (,mword) ((cmd ,cmdsz))
            (bits cmd ,val-lo ,val-hi))
      
      (gaddr (,maddr) ((cmd ,cmdsz))
             (bits cmd ,addr-lo ,addr-hi)) 

      (gcmd (,cmdsz) ((cmds ,isz ,cmdsz) (pt ,ptsz))
            (get cmds pt)))))

; spec-step 
(defun spec-functions (op mword maddr ptsz)
  (let* ((msz (expt 2 maddr))
         (isz (expt 2 ptsz))
         (cmdsz (+ maddr mword op)))
    `(
      (spec-next-mem 
       (,msz ,mword)
       ((mem ,msz ,mword) (cmds ,isz ,cmdsz) (pt ,ptsz) (done 1))
       (if done
           mem
         (local ((cmd (gcmd cmds pt))
                 (op (gop cmd))
                 (addr (gaddr cmd))
                 (val (gval cmd))
                 (((nmem ,msz ,mword) (ignore ,mword))
                  (cond ((= op 0u)
                         (mwrite mem val addr))
                        ((= op 1u)
                         (mread mem addr))
                        ((= op 2u)
                         (mrefresh mem addr))
                        (0b1 (mv mem 0u)))))
                nmem)))

      (spec-next-pt (,ptsz) ((pt ,ptsz))
                    (if  (= pt ,(make-unsigned (- isz 1)))
                        pt
                      (mod+ pt 1u)))
      
      (spec-next-cmds (,isz ,cmdsz) ((cmds ,isz ,cmdsz))
                      cmds)
      
      (spec-next-done (1) ((cmds ,isz ,cmdsz) (pt ,ptsz))
                      (= pt ,(make-unsigned (- isz 1))))

        (spec-step ((,isz ,cmdsz) (,ptsz) (,msz ,mword) (1))
             ((cmds ,isz ,cmdsz) (pt ,ptsz) (mem ,msz ,mword) (done 1))
             (local ((nmem (spec-next-mem mem cmds pt done))
                     (npt (spec-next-pt pt))
                     (ndone (spec-next-done cmds pt)))
                    (mv cmds npt nmem ndone)))
      )))


(defun impl-functions (op mword maddr ptsz ptbufsz sks)
  (let* ((msz (expt 2 maddr))
         (isz (expt 2 ptsz))
         (cmdsz (+ maddr mword op))
         (cbufsz (expt 2 (- ptbufsz 1))))
    `(
      (gcmdimpl (,cmdsz) ((cbuf ,cbufsz ,cmdsz) (ptbuf ,ptbufsz))
                (get cbuf (bits ptbuf 0 ,(- ptbufsz 2))))

      (stutterp (1) ((cmd ,cmdsz) (cbuf ,cbufsz ,cmdsz) (ptcbuf ,ptbufsz) (cmds-done 1))
                (and (> (- ,(make-unsigned cbufsz) ptcbuf) 0)
                     (not (= (gop cmd) 1u))
                     (not cmds-done)))
      

      (impl-next-mem
       (,msz ,mword) ((mem ,msz ,mword) (cmd ,cmdsz)) 
       (local ((op (gop cmd))
               (addr (gaddr cmd))
               (val (gval cmd))
               (((nmem ,msz ,mword) (ignore ,mword))
                (cond ((= op 0u)
                       (mwrite mem val addr))
                      ((= op 1u)
                       (mread mem addr))
                      ((= op 2u)
                       (mrefresh mem addr))
                      (0b1 (mv mem 0u)))))
              nmem))

      (impl-observable-mem-step (,msz ,mword) ((mem ,msz ,mword) (cbuf ,cbufsz ,cmdsz) (ptcbuf ,ptbufsz))
                                ,(impl-observable-mem-step-body cbufsz msz mword sks))
      
      (impl-mem-step (,msz ,mword) ((mem ,msz ,mword) (cbuf ,cbufsz ,cmdsz) (ptcbuf ,ptbufsz) (cmds ,isz ,cmdsz) (pt ,ptsz) (done 1) (cmds-done 1))
                 (if (or (stutterp (gcmd cmds pt) cbuf ptcbuf cmds-done)
                         done)
                     mem
                   (impl-observable-mem-step mem cbuf ptcbuf)))

      (update-cbuf (,cbufsz ,cmdsz) ((cbuf ,cbufsz ,cmdsz) (a ,(- ptbufsz 1)) (v ,cmdsz))
                   (set cbuf a v))

      (impl-stutter-cbuf-step ((,cbufsz ,cmdsz) (,ptbufsz)) ((cmd ,cmdsz) (cbuf ,cbufsz ,cmdsz) (ptcbuf ,ptbufsz))
                              (mv (update-cbuf cbuf (bits ptcbuf 0 ,(- ptbufsz 2)) cmd)
                                  (mod+ ptcbuf 1u)))
      
      
      (impl-no-stutter-cbuf-step ((,cbufsz ,cmdsz) (,ptbufsz)) ((cmd ,cmdsz) (cbuf ,cbufsz ,cmdsz)  (cmds-done 1))
                                 (cond ((or (= (gop cmd) 1u)
                                            cmds-done)
                                        (mv cbuf 0))
                                       (0b1 
                                        (mv (update-cbuf cbuf 0 cmd) 1u))))
      
      (impl-next-cbuf ((,cbufsz ,cmdsz) (,ptbufsz)) ((cmds ,isz ,cmdsz) (pt ,ptsz) (cbuf ,cbufsz ,cmdsz) (ptcbuf ,ptbufsz) (cmds-done 1))
                      (local ((cmd (gcmd cmds pt)))
                             (if (stutterp cmd cbuf ptcbuf cmds-done)
                                 (impl-stutter-cbuf-step cmd cbuf ptcbuf)
                               (impl-no-stutter-cbuf-step cmd cbuf cmds-done))))
      
      (impl-next-cmds-done (1) ((pt ,ptsz))
                           (= pt ,(make-unsigned (- isz 1))))

      (impl-next-done (1) ((ptcbuf ,ptbufsz) (cmds-done 1))
                      (and cmds-done
                           (= ptcbuf 0)))

      (impl-next-pt (,ptsz) ((pt ,ptsz))
                    (if  (= pt ,(make-unsigned (- isz 1)))
                        pt
                      (mod+ pt 1u)))

 
  )))

(defun good-state-function (op mword maddr ptsz ptbufsz)
  (let* ((msz (expt 2 maddr))
         (isz (expt 2 ptsz))
         (cmdsz (+ maddr mword op))
         (cbufsz (expt 2 (- ptbufsz 1))))
    `(
      (good-state-p (1)
                    ((cmds ,isz ,cmdsz) (pt ,ptsz) 
                     (mem ,msz ,mword) (cbuf ,cbufsz ,cmdsz) 
                     (ptcbuf ,ptbufsz) (done 1) (cmds-done 1))
                    (local ,(append `((cpt (mod- pt ,(match-bit-width ptsz ptbufsz 'ptcbuf)))
                                      (ccmds-done (if done cmds-done 
                                                    (cond ((and cmds-done (not (= ptcbuf 0)))
                                                           0b0)
                                                          ((and cmds-done (= ptcbuf 0))
                                                           0b1)
                                                          (0b1 0b0)))))
                                    (unroll-impl-step cbufsz))
                           (and (or (> cpt 0)
                                    (= cpt 0))
                                (if done
                                    cmds-done
                                  ,(cons 'cond (compare-state-from-committed-state cbufsz)))))))))

(defun impl-step-function (op mword maddr ptsz ptbufsz)
  (let* ((msz (expt 2 maddr))
         (isz (expt 2 ptsz))
         (cmdsz (+ maddr mword op))
         (cbufsz (expt 2 (- ptbufsz 1))))
    `((impl-step ((,isz ,cmdsz) (,ptsz) (,msz ,mword) (,cbufsz ,cmdsz) (,ptbufsz) (1) (1))
             ((cmds ,isz ,cmdsz) (pt ,ptsz) (mem ,msz ,mword)
              (cbuf ,cbufsz ,cmdsz) (ptcbuf ,ptbufsz) (done 1) (cmds-done 1))
             (local ((nmem (impl-mem-step mem cbuf ptcbuf cmds pt done cmds-done))
                     (npt (impl-next-pt  pt))
                     ((ncbuf nptcbuf) (impl-next-cbuf cmds pt cbuf ptcbuf cmds-done))
                     (ncmds-done (impl-next-cmds-done pt))
                     (ndone (impl-next-done ptcbuf cmds-done)))
                    (mv cmds npt nmem ncbuf nptcbuf ndone ncmds-done))))))
                     
(defun generate-functions-section (op mword maddr ptsz ptbufsz sks)
  (let ((fns (append (core-functions op mword maddr ptsz)
                     (spec-functions op mword maddr ptsz)
                     (impl-functions op mword maddr ptsz ptbufsz sks))))
    (if sks
        (append fns 
                (impl-step-function op mword maddr ptsz ptbufsz)
                (good-state-function op mword maddr ptsz ptbufsz))
      (append '(":functions") fns))))
         
; transition function
(defun generate-trans-section (op mword maddr ptsz ptbufsz)
  (declare (ignore ptsz))
  (let* ((msz (expt 2 maddr))
         (cmdsz (+ maddr mword op))
         (cbufsz (expt 2 (- ptbufsz 1))))  
    `(":trans" (local ((((nsmem ,msz ,mword)) (spec-next-mem smem scmds spt sdone))
                     (((inmem ,msz ,mword)) (impl-mem-step imem cbuf ptcbuf icmds ipt idone icmds-done))
                     (((ncbuf ,cbufsz ,cmdsz) (nptcbuf ,ptbufsz)) (impl-next-cbuf icmds ipt cbuf ptcbuf icmds-done))
                 )
                    (and (= (next smem) (if (not rstl) input-mem nsmem))
                         (= (next spt) (if (not rstl) 0u (spec-next-pt spt)))
                         (= (next sdone) (if (not rstl) 0u (spec-next-done scmds spt)))
                         (= (next scmds) (if (not rstl) input-cmds scmds))
                         (= (next rstl) 1u)
                     ; implementation state
                     (= (next imem) (if (not rstl) input-mem inmem))
                     (= (next ipt) (if (not rstl) 0 (impl-next-pt ipt)))
                     (= (next idone) (if (not rstl) 0 (impl-next-done ptcbuf icmds-done)))
                     (= (next icmds-done) (if (not rstl) 0 (impl-next-cmds-done ipt)))
                     (= (next cbuf) (if (not rstl) 0 ncbuf))
                     (= (next ptcbuf) (if (not rstl) 0 nptcbuf))
                     (= (next icmds) (if (not rstl) input-cmds icmds)))))))

(defun io-property ()
  `(":spec" (-> (and idone sdone) 
                (and  (= smem imem)
                      (= icmds scmds)
                      (= ipt spt)))))

(defun generate-mem-ctrl-machine-io (op mword maddr ptsz ptbufsz)
(let* ((msz (expt 2 maddr))
       (isz (expt 2 ptsz))
       (cmdsz (+ maddr mword op))
       (cbufsz (expt 2 (- ptbufsz 1))))
  `(":machine" (,(generate-functions-section op mword maddr ptsz ptbufsz nil)
                (":vars" (rstl 1) (input-cmds ,isz ,cmdsz) (input-mem ,msz ,mword)   
                 (smem ,msz ,mword) (scmds ,isz ,cmdsz) (spt ,ptsz)  (sdone 1) 
                 (imem ,msz ,mword) (icmds-done 1) (idone 1) (icmds ,isz ,cmdsz)
                 (ipt ,ptsz) (cbuf ,cbufsz ,cmdsz) (ptcbuf ,ptbufsz))
                (":init" 0b1)
                ,(generate-trans-section op mword maddr ptsz ptbufsz)
                ,(io-property))
    1)))

(defun good-state-inductive (n)
  `(-> (and (-> idone icmds-done)
            (< ptcbuf ,(make-unsigned (+ n 1))) 
            (good-state-p cmds ipt imem cbuf ptcbuf idone icmds-done))
       (and (< nptcbuf ,(make-unsigned (+ n 1)))
            (good-state-p nicmds nipt nimem ncbuf nptcbuf nidone nicmds-done))))


(defun sks-property (n)
  `(-> (and (not icmds-done)
                (= smem imem) ; w = ref-map(s)
                (= spt ript)
                (= sdone idone)
                (< ptcbuf ,(make-unsigned (+ n 1))) 
                (good-state-p cmds ipt imem cbuf ptcbuf idone icmds-done) ; good-map (s)
                (not (and (= imem nimem) ; (not ((ref-map s = ref-map u) /\ (< (rank u) (rank s))))
                          (= ript nript)
                          (= nidone idone)
                          (< (- ,(make-unsigned (+ n 1)) nptcbuf) 
                             (- ,(make-unsigned (+ n 1)) ptcbuf)))))
       ,(cons 'or (compare-impl-and-spec-state n))))

(defun generate-sks-property (op mword maddr ptsz ptbufsz)
  (declare (ignore op mword maddr))
  (let* ((cbufsz (expt 2 (- ptbufsz 1))))
    `(local ,(append (unroll-spec-step cbufsz)
                      `(((nicmds nipt nimem ncbuf nptcbuf nidone nicmds-done)
                         (impl-step icmds ipt imem cbuf ptcbuf idone icmds-done))
                        (ript (mod- ipt  ,(match-bit-width ptsz ptbufsz 'ptcbuf)))
                        (nript (mod- nipt ,(match-bit-width ptsz ptbufsz 'nptcbuf)))))
            (and ,(good-state-inductive cbufsz)
                 ,(sks-property cbufsz)))))


(defun generate-mem-ctrl-machine-sks (op mword maddr ptsz ptbufsz)
  (let* ((msz (expt 2 maddr))
         (isz (expt 2 ptsz))
         (cmdsz (+ maddr mword op))
         (cbufsz (expt 2 (- ptbufsz 1))))
    `(":forall"
      ((smem ,msz ,mword) (cmds ,isz ,cmdsz) (spt ,ptsz) (sdone 1)
       (imem ,msz ,mword) (icmds-done 1) (idone 1) (icmds ,isz ,cmdsz)
       (ipt ,ptsz) (cbuf ,cbufsz ,cmdsz) (ptcbuf ,ptbufsz))
      ,(generate-functions-section op mword maddr ptsz ptbufsz t)
      ,(generate-sks-property op mword maddr ptsz ptbufsz))))

(defun gen-mem-ctrl-machine-io (op mword maddr ptsz ptbufsz fname)
  (let* ((l (generate-mem-ctrl-machine-io op mword maddr ptsz (+ 1 ptbufsz)))         
         (bla (format t "model: ~x~%" fname)))
    (declare (ignore bla))
    (print-to-file l fname)))

(defun gen-mem-ctrl-machine-sks (op mword maddr ptsz ptbufsz fname)
  (let* ((l (generate-mem-ctrl-machine-sks op mword maddr ptsz (+ 1 ptbufsz)))         
         (bla (format t "Model: ~x~%" fname)))
    (declare (ignore bla))
    (print-to-file l fname)))


(defun gen-mem-ctrl-machine-aux (mword maddr ptsz ptbufsz sks-io fname)
  (let ((op 2))
    (if (<= ptsz ptbufsz)
        (format t "argument pt must be > than ptbuf")
      (if (equal sks-io "sks")
          (gen-mem-ctrl-machine-sks op mword maddr ptsz ptbufsz fname)
        (if (equal sks-io "io")
            (gen-mem-ctrl-machine-io op mword maddr ptsz ptbufsz fname)
          (format t "Unknownly property: io or sks~%"))))))

(defun gen-mem-ctrl-machine (mword maddr ptsz ptbufsz sks-io)
  (let ((fname (if (equal sks-io "sks")
                   (format nil "skip-mem-~D-word-~D-ibuf-~D-imem-~D.lisp" 
                           (expt 2 maddr) mword (expt 2 ptbufsz) (expt 2 ptsz))
                 (if (equal sks-io "io")
                     (format nil "mem-~D-word-~D-ibuf-~D-imem-~D.lisp" 
                             (expt 2 maddr) mword (expt 2 ptbufsz) (expt 2 ptsz))
                   (format t "Unknownly property: io or sks~%")))))
    (gen-mem-ctrl-machine-aux mword maddr ptsz ptbufsz sks-io fname)))

(defun run-sksbat2aig (fname)
  (sb-ext:run-program *bat2cnf* (list "-solver" "none" "-r" fname) :wait t :if-output-exists :supersede :search t)
  (let ((cnf (format nil "~A.cnf" fname))
        (aig (format nil "~A.aig" fname)))
    (sb-ext:run-program *cnf2aig* (list cnf aig) :wait t :if-output-exists :supersede :search t)))

(defun generic-run-aig (sks-io fname)
  (cond ((equal sks-io "io")
         (sb-ext:run-program *bat2aig* (list fname) :wait t :if-output-exists :supersede :search t))
        ((equal sks-io "sks")
         (run-sksbat2aig fname))
        (t nil)))

(defun gen-mem-ctrl-machine-aig (mword maddr ptsz ptbufsz sks-io)
  (declare (special *bat2aig*))
  (let ((fname (if (equal sks-io "sks")
                   (format nil "skip-mem-~D-word-~D-ibuf-~D-imem-~D.lisp" 
                           (expt 2 maddr) mword (expt 2 ptbufsz) (expt 2 ptsz))
                 (if (equal sks-io "io")
                     (format nil "mem-~D-word-~D-ibuf-~D-imem-~D.lisp" 
                             (expt 2 maddr) mword (expt 2 ptbufsz) (expt 2 ptsz))
                   (format t "Unknownly property: io or sks~%")))))
    (gen-mem-ctrl-machine-aux mword maddr ptsz ptbufsz sks-io fname)
      (format t "converting to aig~%")
      (format t "aig: ~x.aig~%" fname)
      (generic-run-aig sks-io fname)))

(defun print-usage()
  (format t 
          "Usage:~%
               gen-mem-ctrl <mword> <maddr> <ptsz> <ptbufsz> <sks-io> ~%
               mword : number of bits in a  word in data memory~%
               maddr : number of address bits to address data memory (= log (size of data memory))~%
               ptsz : number of address bits to address imem (= log (size of instruction memory))~%
               ptbufsz : number of address bits to address internal buffer (ibuf)~%
               sks-io:  one of \"io\" or \"sks\"~%"))

(defun extract-args (l)
  (let* ((mword (parse-integer (nth 0 l)))
         (maddr (parse-integer (nth 1 l)))
         (ptsz (parse-integer (nth 2 l)))
         (ptbufsz (parse-integer (nth 3 l)))
         (sks-io (nth 4 l)))
    (values mword maddr ptsz ptbufsz sks-io)))


(defun main (&rest args)
  (cond ((or (not (equal (length args) 5))
             (equal args "-h"))
         (print-usage))
        (t (multiple-value-bind (mword maddr ptsz ptbufsz sks-io)
               (extract-args args)
             (gen-mem-ctrl-machine-aig mword maddr ptsz ptbufsz sks-io)))))

   
(save-lisp-and-die
 "gen-mem-ctrl"
 :toplevel (lambda ()
             (apply #'main
                    (cdr *posix-argv*)))
 :executable t)