#lang scheme/base

;; PICkit2 config file parser.

;; Abbrev
(define band bitwise-and)
(define bxor bitwise-xor)
(define <<<  arithmetic-shift)

;; Scalars
(define (little-endian . bytes)
  (if (null? bytes) 0
      (+ (car bytes)
         (* 256 (apply little-endian (cdr bytes))))))
(define (signed value bits)
  (let ((sign (band (<<< 1 (sub1 bits)))))
    (- (bxor value sign) sign)))
(define b        read-byte)
(define uchar    b)
(define (uint64) (little-endian (b) (b) (b) (b) (b) (b) (b) (b)))
(define (uint)   (little-endian (b) (b) (b) (b)))
(define (ushort) (little-endian (b) (b)))
(define (int)    (signed (uint) 32))
(define float    uint)  ;; FIXME
(define bool     uchar) 

;; Arrays
(define (array type [size #f])
  (if (not size)
      (type)
      (for/list ((i (in-range size))) (type))))
(define (ushortstring)
  (array ushort (ushort)))

;; Strings
(define (string)
  (read-bytes
   (let ((n (b)))
     (if (= 0 (band n #x80))
         n
         (+ (band n #x7f)
            (* #x80 (b)))))))

;; Read whole file.
(define (read-device-file file)
  (define params #f)
  (define h (make-hash))
  (define (_table id reader)
    (for/list ((i (in-range (hash-ref params id)))) (reader)))
  (define-syntax-rule (table id reader)
    (hash-set! h 'reader (_table 'id reader)))
  (with-input-from-file file
    (lambda ()
      (set! params (DeviceFileParams))
      (hash-set! h 'DeviceFileParams params)
      (table NumberFamilies DeviceFamilyParams)
      (table NumberParts    DevicePartParams)
      (table NumberScripts  DeviceScripts)))
  h)

;; Create reader from table.
(define-syntax-rule (define-reader name (type id . args) ...)
  (define (name)
    (make-immutable-hash
     (list (cons 'id (apply array type 'args)) ...))))

;; Write pretty-printed
(define (dat->tree dat)
  (hash-map
   dat
   (lambda (key value)
     (cons key
           (if (hash? value)
               (hash-map value cons)
               (map
                (lambda (h)
                  (hash-map h cons))
                value))))))


(define-reader DeviceFileParams
 (int VersionMajor)
 (int VersionMinor)
 (int VersionDot)
 (string VersionNotes) ;;[512]
 (int NumberFamilies)
 (int NumberParts)
 (int NumberScripts)
 (uchar Compatibility)
 (uchar UNUSED1A)
 (ushort UNUSED1B)
 (uint UNUSED2))

(define-reader DeviceFamilyParams
 (ushort FamilyID)
 (ushort FamilyType)
 (ushort SearchPriority)
 (string FamilyName) ;; [24]
 (ushort ProgEntryScript)
 (ushort ProgExitScript)
 (ushort ReadDevIDScript)
 (uint DeviceIDMask)
 (uint BlankValue)
 (uchar BytesPerLocation)
 (uchar AddressIncrement)
 (bool PartDetect)
 (ushort ProgEntryVPPScript)
 (ushort UNUSED1)
 (uchar EEMemBytesPerWord)
 (uchar EEMemAddressIncrement)
 (uchar UserIDHexBytes)
 (uchar UserIDBytes)
 (uchar ProgMemHexBytes)
 (uchar EEMemHexBytes)
 (uchar ProgMemShift)
 (uint TestMemoryStart)
 (ushort TestMemoryLength)
 (float Vpp))

(define-reader DevicePartParams
 (string PartName) ;; [28]
 (ushort Family)
 (uint DeviceID)
 (uint ProgramMem)
 (ushort EEMem)
 (uint EEAddr)
 (uchar ConfigWords)
 (uint ConfigAddr)
 (uchar UserIDWords)
 (uint UserIDAddr)
 (uint BandGapMask)
 (ushort ConfigMasks 8)
 (ushort ConfigBlank 8)
 (ushort CPMask)
 (uchar CPConfig)
 (bool OSSCALSave)
 (uint IgnoreAddress)
 (float VddMin)
 (float VddMax)
 (float VddErase)
 (uchar CalibrationWords)
 (ushort ChipEraseScript)
 (ushort ProgMemAddrSetScript)
 (uchar ProgMemAddrBytes)
 (ushort ProgMemRdScript)
 (ushort ProgMemRdWords)
 (ushort EERdPrepScript)
 (ushort EERdScript)
 (ushort EERdLocations)
 (ushort UserIDRdPrepScript)
 (ushort UserIDRdScript)
 (ushort ConfigRdPrepScript)
 (ushort ConfigRdScript)
 (ushort ProgMemWrPrepScript)
 (ushort ProgMemWrScript)
 (ushort ProgMemWrWords)
 (uchar ProgMemPanelBufs)
 (uint ProgMemPanelOffset)
 (ushort EEWrPrepScript)
 (ushort EEWrScript)
 (ushort EEWrLocations)
 (ushort UserIDWrPrepScript)
 (ushort UserIDWrScript)
 (ushort ConfigWrPrepScript)
 (ushort ConfigWrScript)
 (ushort OSCCALRdScript)
 (ushort OSCCALWrScript)
 (ushort DPMask)
 (bool WriteCfgOnErase)
 (bool BlankCheckSkipUsrIDs)
 (ushort IgnoreBytes)
 (ushort ChipErasePrepScript)
 (uint BootFlash)
 (uint UNUSED4)
 (ushort ProgMemEraseScript)
 (ushort EEMemEraseScript)
 (ushort ConfigMemEraseScript)
 (ushort reserved1EraseScript)
 (ushort reserved2EraseScript)
 (ushort TestMemoryRdScript)
 (ushort TestMemoryRdWords)
 (ushort EERowEraseScript)
 (ushort EERowEraseWords)
 (bool ExportToMPLAB)
 (ushort DebugHaltScript)
 (ushort DebugRunScript)
 (ushort DebugStatusScript)
 (ushort DebugReadExecVerScript)
 (ushort DebugSingleStepScript)
 (ushort DebugBulkWrDataScript)
 (ushort DebugBulkRdDataScript)
 (ushort DebugWriteVectorScript)
 (ushort DebugReadVectorScript)
 (ushort DebugRowEraseScript)
 (ushort DebugRowEraseSize)
 (ushort DebugReserved5Script)
 (ushort DebugReserved6Script)
 (ushort DebugReserved7Script)
 (ushort DebugReserved8Script)
 (ushort DebugReserved9Script))

(define-reader DeviceScripts
 (ushort ScriptNumber)
 (string ScriptName) ;; [32]
 (ushort ScriptVersion)
 (uint UNUSED1)
 ;;(ushort ScriptLength)
 ;;(ushort Script[64])
 (ushortstring Script)
 (string Comment)) ;; [128]



;; Test
(define dat  (read-device-file "/tmp/test.dat"))