;
; Program Xilinx FPGA from PC through TDC command bus interface
; for use with FPGAPGMA CLPD on TDC INPUT & OUTPUT cards
;
; input file is formated with:
;  "PROM File Formatter"
;     File -> PROM Properties -> 
;               Serial, Single PROM, Hex File, Swap Bits ON
;
(load "c:/s88/v28/bool.so")

(define read-chars
  (lambda (ip n)
    (if (zero? n) #t
	(begin
	  (display (read-char ip))
	  (read-chars ip (sub1 n))))))

(define resetfpga-input
  (lambda ()
    (vme-write-byte #x1d fpga-mask) ; set CCLK mask
    (vme-write-byte #x1e 4) ; turn on PROGRAM.L
    (vme-write-byte #x1e 0) ; turn off PROGRAM.L
    (vme-write-byte #x1e 0) ; turn off PROGRAM.L
    (vme-write-byte #x1e 0) ; turn off PROGRAM.L
    #t))

(define resetfpga-output
  (lambda ()
    (vme-write-byte #x10fd fpga-mask) ; set CCLK mask
    (vme-write-byte #x10fe 4) ; turn on PROGRAM.L
    (vme-write-byte #x10fe 0) ; turn off PROGRAM.L
    (vme-write-byte #x10fe 0) ; turn off PROGRAM.L
    (vme-write-byte #x10fe 0) ; turn off PROGRAM.L
    #t))

(define resetspin
  (lambda ()
    (vme-write-byte #x1e 4) ; turn on PROGRAM.L
    (vme-write-byte #x1e 0) ; turn off PROGRAM.L
    (resetspin)))

;
;  program fpga's
;

(define fpga-mask #xff)
(define fpga-pgm-bit (lambda (b) b))

(define fpga-status-bits
  (lambda ()
    (let ((sii (number->string (vme-read-byte #x1f) 2))
          (sio (number->string (vme-read-byte #x10ff) 2))
	  (dii (number->string (vme-read-byte #x1d) 2))
          (dio (number->string (vme-read-byte #x10fd) 2))  )
      (writeln "INIT's INPUT" sii "    OUTPUT "sio)
      (writeln "DONE's INPUT" dii "    OUTPUT "dio))))


(define pgm
  (lambda (file fpga)
    (cond
      ((eq? fpga 'inrx)
       (set! fpga-mask #xc0)
       (set! fpga-pgm-bit
	 (lambda (b)
	   (vme-write-byte #x1f (if (zero? (band 1 b)) 0 #x3f))))  ; 3f
       (resetfpga-input)
       )
      ((eq? fpga 'imux)
       (set! fpga-mask #x3f)
       (set! fpga-pgm-bit 
	 (lambda (b) 
	   (let ((pb (if (zero? (band 1 b)) 0 #xc0)))
	     (vme-write-byte #x1f pb))))
       (resetfpga-input)      
       )
      ((eq? fpga 'oscore)
       (set! fpga-mask #xfe)
       (set! fpga-pgm-bit 
	 (lambda (b) 
	   (let ((pb (if (zero? (band 1 b)) 0 #x1)))
	     (vme-write-byte #x10ff pb))))
       (resetfpga-output)      
       )
      ((eq? fpga 'oglmux)
       (set! fpga-mask #xfd)
       (set! fpga-pgm-bit 
	 (lambda (b) 
	   (let ((pb (if (zero? (band 1 b)) 0 #x2)))
	     (vme-write-byte #x10ff pb))))
       (resetfpga-output)      
       )

      (else (error 'pgm "fpga ~s not supported" fpga)))

    (delay 10000)
    (fpga-status-bits)
    (let ((ip (open-input-file file)))

      (read-xlinx-loop ip 0)
      (close-input-port ip)
      (vme-write-byte #x1d #xff) ; set CCLK mask to NO fpga
      (vme-write-byte #x10fd #xff) ; set CCLK mask to NO fpga
      (fpga-status-bits)

      )))

(define read-xlinx-loop
  (lambda (ip c)
    (let ((token1 (read-char ip))
	  (token2 (read-char ip)))
      (if (eof-object? token1)
	  (begin
	    (newline)
	    (writeln "file size ="c)
	    c)
	  (let
	    ((v1 (hex->int token1))
	     (v2 (hex->int token2)))
	    (if v2 (download-xlinx-nibble v2 4) #f)
	    (if v1 (download-xlinx-nibble v1 4) #f)
	    (read-xlinx-loop ip (add1 c)))))))

(define hex->int
  (lambda (t)
    (let* ((c (char->integer t))
	   (n (- c 48))
	   (l (- c 87)))
      (cond
	((< n 0) (writeln 'hex->int "bad char"c) #f)
	((< n 10) n)
	((< l 10) (writeln 'hex->int "bad char"c) #f)
	((< l 16) l)
	(else (writeln 'hex->int "bad char"c) #f)))))

(define pc-pport #x378)

(define download-xlinx-nibble
  (lambda (v n)
    (if (zero? n) #f
	(begin
          (fpga-pgm-bit v)  ; send bit to fpga's DIN and cycle CCLK
	  
	  (download-xlinx-nibble (quotient v 2) (- n 1))))))
	      
(define delay
  (lambda (n)
    (if (zero? n) #t 
	(delay (sub1 n)))))