'PIC-PROG.BAS - version 1.3 - 17 Oct. 2001 - Victor F1BIU - f1biu@cybercable.fr
'This program requires QBASIC V1.0 and up (english or french version)
'Cette programme a besoin de QBASIC V1.0 et plus (version fran‡ais ou anglais)
'23 Aug. 2001 V1.2 :
'English translation and addition of acceptance of .hex files including check
'on data structure compliance added by Hartwig, DH2MIC, dh2micdarc.de
'17 Oct. 2001 V1.3 :
'Replaced INPUT #1, D$ by a Subroutine, because the TinyTrak-HEX-File from
'DK7IN had only &h10 (LF) as delimiter, &h13 (CR) was missing
'                                      
'Remark: PIC16F628 is except for 128 bytes of EEPROM identical to 16F84
'        The extended data range however is not supported yet.
'
CLS : KEY OFF: COLOR 10, 0
PRINT "Fran‡ais (F) ou/or english (E): ";
DO
  Lang$ = UCASE$(INKEY$)
  IF Lang$ <> "" THEN EXIT DO
LOOP
IF Lang$ = "F" THEN Lang = 1 ELSE Lang = 0
CLS
IF Lang = 1 THEN
  PRINT "         Logiciel de chargement de programme pour PIC s‚rie 16x84"
  PRINT "                de Victor F1BIU (Version 1.1  25/4/98)"
  PRINT "    modifikation et traduction en anglais par Hartwig DH2MIC, 25/4/01"
ELSE
  PRINT "    Program for loading program code and EEPROM data into a PIC 16x84"
  PRINT "                de Victor F1BIU (Version 1.1  25/4/98)"
  PRINT "     modified and translated into english by Hartwig DH2MIC, 25/4/01"
END IF
PRINT

'la programmation du pic suit cette proc‚dure:
'v‚rification du mot "84" en ligne FFFEh du fichier .obj, pour pic 16x84.
'le pic est reset‚ une 1ere fois.
'‚criture du mot &HFF de configuration pour d‚sactiver le mode protection.
'le pic est reset‚ une nouvelle fois.
'le mot d'itentification en ligne 4000h du fichier .obj est log‚ dans le pic.
'le mot de configuration en ligne 400Eh du fichier .obj est log‚ dans le pic.
'la m‚moire programme est ‚crite de la maniŠre suivante:
'‚criture de la commande [‚criture-programme] suivie par 0+14 bits de data+0.
'commande [d‚but-programmation] suivie d'une attente de 10 ms
'commande [incr‚mentation] d'adresse.
'boucle jusqu'… la fin du buffer programme.
'reset du pic une nouvelle fois.
'‚criture des datas en m‚moire eeprom datas.
'idem ‚criture m‚moire programme sauf mot de commande nomm‚ [‚criture-eeprom].
'boucle de 64 jusqu'… la fin du buffer eeprom.
'la programmation est finie.
'la broche MCLR est maintenue basse mat‚riellement, pour reseter le pic.
'la broche MCLR est d‚sactiv‚e (haut), le pic peut ex‚cuter le programme cible
'tout en restant dans le programmateur.

'---------------------------------------------------------------------------





'----------------------D‚claration de variables-----------------------------
ECRITCONF = &H0:     'commande ‚criture-mot-de-config
CHPM = &H2:          'commande ‚criture-programme.
LECTDATAPROG = &H4:  'lecture datas de la m‚moire programme, non utilis‚.
INCADR = &H6:        'commande d'incr‚mentation adresse
Debutprog = &H8:     'commande d‚but-programmation
ECRITDATAMEM = &H3:  'commande ‚criture-eeprom.
LECTDMEMD = &H5:     'lecture datas de la m‚moire datas
EFFACMEMPROG = &H9:  'effacement m‚moire programme, non utilis‚.
EFFMEMDATA = &HB:    'effacement m‚moire datas, non utilis‚.
PP = &H378:          'adresse de sortie port parallŠle lpt1
REGDECDATA = &H0:    'registre … d‚calage pour datas de 14bits.
REGDECCOMMAND = &H0: 'registre … d‚calage pour commande de 6bits.
SORTIEVAR = &H0:     'Sortie variable, pour port parallŠle
DIM bufprog(1024) AS DOUBLE:
DIM bufdataeeprom(64)  AS INTEGER:
tailleprog = 0
ida$ = "": idb$ = "": idc$ = "": idd$ = ""
REM fin de d‚claration de variables
'---------------------------------------------------------------------------


'---------------------------------------------------------------------------
F$ = "": D$ = ""
OUT PP, &H4: 'PIC en mode reset
ligne = CSRLIN
GOTO bou2
'
again:
LOCATE ligne, 1, 1
IF Lang = 1 THEN
  PRINT "Fichier '"; F$; "' n'existe pas.";
ELSE
  PRINT "File '"; F$; "' not found.      ";
END IF
PRINT SPACE$(55 - LEN(F$))
V = TIMER:  'pour implementer une tempo
WHILE TIMER < V + 2: WEND   'tempo de 2 secondes
RESUME bou2
'---------------------------------------------------------------------------



'---------------------------------------------------------------------------
REM ouverture fichier obj ou hex
bou2:
LOCATE ligne, 1, 1
IF Lang = 1 THEN
  INPUT "Entrez le nom du fichier .obj ou .hex"; F$
ELSE
  INPUT "Enter [path\]name.ext of .OBJ or .HEX data file "; F$
END IF
F$ = UCASE$(F$)
PRINT
IF F$ = "" OR (INSTR(F$, ".OBJ") < 2 AND INSTR(F$, ".HEX") < 2) THEN GOTO bou2
ON ERROR GOTO again
OPEN F$ FOR INPUT AS #1
ON ERROR GOTO 0
IF EOF(1) THEN END
'
IF INSTR(F$, ".HEX") > 1 THEN GOTO HEX
'
'V‚rification de la version PIC ‚crite en ligne FFFEh du fichier .obj
WHILE NOT EOF(1)
  GOSUB ReadD                                 'INPUT #1, D$
  IF MID$(D$, 4, 4) = "FFFE" THEN GOTO aff
WEND
CLOSE #1
GOTO erreur

aff:
CLOSE #1
a$ = MID$(D$, 10, 2)
IF a$ <> "84" THEN GOTO erreur
'CLS
IF Lang = 1 THEN
  PRINT "             OK, votre fichier concerne bien un PIC xx84"
ELSE
  PRINT "             OK, your file is representing PIC xx84 data"
END IF
V = TIMER:  'pour implementer une tempo
bo: IF TIMER < V + 2 THEN GOTO bo 'tempo de 2 secondes
GOTO suite2
   
erreur:
CLS
IF Lang = 1 THEN
  PRINT "Votre fichier ne concerne pas un PIC 16x84 , v‚rifiez votre fichier .obj"
  PRINT "Les deux dernier lignes doivent ˆ'tre:"
ELSE
  PRINT "Your .OBJ file does not contain the PIC 16x84 identification data. Check it!"
  PRINT "The last two lines must be: "
END IF
PRINT "     :02FFFE00840F6E"
PRINT "     :00000001FF"
END
GOTO suite2

HEX:
'
'V‚rification d'un fichier .hex pour pic 16x84
'
'ROM=0000-07FF, EEPROM=4200-427F, Config: 400E-400F, Ident: 4000-4007
'    14bit             8bit               14bit             8bit, optional
'
IF Lang = 1 THEN
  PRINT "En train de verifier la structure characteristique des donn‚es..."
ELSE
  PRINT "Looking for characteristic structure of data..."
END IF
PRINT
'
'D‚codage adresse du fichier .hex, … la position 4, taille 4 de chaque ligne.
D$ = "": CKRES = 0: CKADR = 0
DO
  IF CKADR > 0 OR EOF(1) THEN EXIT DO
  GOSUB ReadD                     'Ersatz fr "INPUT #1, D$" bei fehlendem CR
  IF MID$(D$, 9, 1) = "1" THEN EXIT DO     'fin du fichier .obj ou .hex
  longueur = LEN(D$): 'longueur complŠte de la ligne
  adresse$ = MID$(D$, 4, 4): 'adresse des datas … ‚crire
  adresse = VAL("&H" + adresse$) / 2:  'conversion adresse en d‚cimal
  words = (longueur - 11) / 4
  SELECT CASE adresse                  'verification d'adresse et data
    CASE 0 TO 1023
      found(1) = found(1) + words   ' rom data count
      IF adresse + words > 1024 THEN CKRES = CKRES + adresse + words - 1024
      GOSUB check14
    CASE 8448 TO 8511
      found(2) = found(2) + words   ' eeprom data count
      IF adresse + words > 8512 THEN CKRES = CKRES + adresse + words - 8512
      GOSUB check8
    CASE 8512 TO 8575
      IF Lang = 1 THEN
        PRINT "Attention: Vous avez besoin d'un PIC16F628 !"
      ELSE
        PRINT "Attention: Need PIC16F628 due to more than 64 bytes of EEPROM !"
      END IF
      PRINT "PIC16F628 is not supported !"
    CASE 8199
      found(3) = found(3) + words   ' config word count
      IF words > 1 THEN CKRES = CKRES + words - 1
      GOSUB check14
    CASE 8192 TO 8195
      found(4) = found(4) + words   ' identification data count
      IF adresse + words > 8196 THEN CKRES = CKRES + adresse + words - 8196
      GOSUB check8
    CASE -1
      found(5) = found(5) + words   ' *.OBJ marker
      IF words > 1 THEN CKRES = CKRES + words - 1
    CASE ELSE
      CKADR = 1
      IF Lang = 1 THEN
        PRINT "ERREUR: L'adresse suivante n'est pas valide:"
      ELSE
        PRINT "ERROR: Address of following line out of allowed range:"
      END IF
      PRINT D$
      PRINT
  END SELECT
LOOP                           'fin de la boucle do..loop
CLOSE #1
IF CKRES > 0 OR CKADR > 0 THEN
  IF Lang = 1 THEN
    PRINT "Votre fichier ne correspond pas … soit la structure d'un fichier .hex 16x84"
    PRINT "ou les donnes ne sont pas valide pour 8 ou 14 bits."
    PRINT "Nombre des erreurs:"; CKRES
  ELSE
    PRINT "Your file does NOT correspond either with the structure of a .HEX file for"
    PRINT "a PIC 16x84 or the data are outside the allowed range(s) of 14 or 8 bit."
    PRINT "Number of mismatches are:"; CKRES
  END IF
  END
ELSE
  IF Lang = 1 THEN
    PRINT "OK, votre fichier concerne bien un pic 16x84."
    PRINT "Trouver:"; found(1); "mots de CODE,"; found(2); "bytes EEPROM,";
    PRINT found(3); "mot de configuration,"
    IF found(4) > 0 THEN PRINT LTRIM$(STR$(found(4)));  ELSE PRINT "Aucun";
    PRINT " data d'identification et";
    IF found(5) > 0 THEN PRINT found(5);  ELSE PRINT " aucun ";
    PRINT "byte characteristique pour fichier .obj."
  ELSE
    PRINT "OK, file structure complies with requirements for a pic 16x84."
    PRINT "Found:"; found(1); "CODE words,"; found(2); "EEPROM bytes,";
    PRINT found(3); "Configuration word,"
    IF found(4) > 0 THEN PRINT LTRIM$(STR$(found(4)));  ELSE PRINT "No";
    PRINT " Identification data and";
    IF found(5) > 0 THEN PRINT found(5);  ELSE PRINT " no ";
    PRINT "*.OBJ PICxx84 characteristic byte."
  END IF
END IF
'---------------------------------------------------------------------------
'Configuration word specification for 16F83 and 16F84:
'   bit 13:4 Code Protection bits:
'            3FFxh = Code Protection OFF (x = bit3:0 below),
'            000xh = All Memory Code is protected
'   bit 3    /PWRTE Power-up Timer Enable bit
'            1 = Power-up Timer is disabled
'            0 = Power-up Timer is enabled
'   bit 2    WDTE Watchdog Timer Enable bit
'            1 = WDTE enabled
'            0 = WDTE disabled
'   bit1:0   FOSC1:1/FOSC2:0 Oscillator selection bits
'            11 = RC Resistor/Capacitor oscillator (C>20pF, 5k<R<100k) *)
'            10 = HS High Speed Crystal/Resonator oscillator (8-10MHz)
'            01 = XT Crystal/Resonator oscillator (455kHz-4MHz)
'            00 = LP Low Power Crystal oscillator (32-200kHz)
'   *) 22pF + 5.6k will be approximately 4 MHz
'---------------------------------------------------------------------------


'----------------------- effacement du pic ---------------------------------
suite2:
PRINT
IF Lang = 1 THEN
  PRINT "1)-Coupez l'alimentation du programmateur, placez le pic dans le socle."
  PRINT "2)-Alimentez le programmateur."
  PRINT "3)-Activez le 13V par le switch 13v on/off. "
  PRINT
  PRINT "Appuyer sur une touche pour continuer";
ELSE
  PRINT "1)-Switch power of programmer OFF, then insert PIC into the socket."
  PRINT "2)-Switch power of programmer ON (5V only, 13V switch must be OFF)."
  PRINT "3)-Activate the 13V by means of the 13V ON/OFF switch."
  PRINT
  PRINT "Press any key when ready";
END IF
bou1: IF INKEY$ = "" THEN GOTO bou1
ligne = CSRLIN
LOCATE ligne, 1, 1
PRINT SPACE$(79);
LOCATE ligne, 1, 1

'un reset du mot de configuration est n‚cessaire ici pour tout nettoyer,
'et le code de protection est d‚sactiv‚ par la programmation du pic.
'la d‚sactivation du mot de protection efface l'ancien contenu du pic,
'vous ne pourrez donc pas pirater.
'

'la proc‚dure d'effacement est la suivante:
'1- reset du pic.
'2- ‚criture du mot de commande ‚criture-mot-de-config, mot de 6bits.
'3- incr‚mentation de l'adresse 7 fois.
'4- ‚criture du mot FFh … l'adresse du mot de configuration.
'5- ‚criture du mot de commande 1 puis 7 (mots de 6bits)
'6- ‚criture mot de commande d‚but-programmation (mot de 6 bits)
'7- attente 10mS.
'8- ‚criture du mot de commande 1 puis 7 (mots de 6bits)

effacement:
IF Lang = 1 THEN
  PRINT "Effacement de la m‚moire: ";
ELSE
  PRINT "Clearing the memory: ";
END IF
OUT PP, &H0: OUT PP, &H4: OUT PP, &H0: 'le PIC est reset‚.
FOR te = 1 TO 10: NEXT te
REGDECCOMMAND = ECRITCONF: GOSUB ecrit6bits: '‚criture commande configuration
REGDECDATA = VAL("&HFF")
REGDATALEN = 2
GOSUB ECRIT14BITS

'Incrementer … 0x2007
FOR n = 1 TO 7: REGDECCOMMAND = INCADR: GOSUB ecrit6bits: NEXT n:

REGDECCOMMAND = &H1: GOSUB ecrit6bits:
REGDECCOMMAND = &H7: GOSUB ecrit6bits
REGDECCOMMAND = Debutprog: GOSUB ecrit6bits:   'd‚but de programmation
V = TIMER:  'pour implementer une tempo de 10 ms
bou3: IF TIMER < V + .02 THEN GOTO bou3
REGDECCOMMAND = &H1: GOSUB ecrit6bits
REGDECCOMMAND = &H7: GOSUB ecrit6bits
'----------------- fin d'effacement du pic ---------------------------------



'-------- saisie du contenu fichier .obj et mis en buffers temporaires -----
'init buffers
FOR n = 0 TO 1023: bufprog(n) = VAL("&H3FFF"): NEXT n
FOR n = 0 TO 63: bufdataeeprom(n) = VAL("&HFF"): NEXT n

OPEN F$ FOR INPUT AS #1
'D‚codage adresse du fichier .obj, … la position 4, taille 4 de chaque ligne.
D$ = ""
WHILE MID$(D$, 9, 1) <> "1"   'fin du fichier .obj ou .hex?
  GOSUB ReadD                 'INPUT #1, D$
  longueur = LEN(D$): 'longueur complŠte de la ligne
  adresse$ = MID$(D$, 4, 4): 'adresse des datas … ‚crire
  adresse = VAL("&H" + adresse$) / 2:  'conversion adresse en d‚cimal
  IF (adresse >= 0 AND adresse < 1024) THEN GOSUB remplirbufprog
  IF MID$(D$, 4, 2) = "42" THEN GOSUB remplirbufeeprom
  IF MID$(D$, 4, 4) = "4000" THEN GOSUB identificateur
  IF MID$(D$, 4, 4) = "400E" THEN GOSUB ecritmotdeconfig
WEND:     'fin de la boucle while

'----------------- fin de saisie du contenu du fichier .obj ou .hex---------





'------------------ ‚criture en m‚moire programme --------------------------
ecritdataprog:
' Programmation m‚moire programme
PRINT : PRINT
IF Lang = 1 THEN
  PRINT "Ecriture en m‚moire programme: "
ELSE
  PRINT "Writing into the program memory: "
END IF
OUT PP, &H0: OUT PP, &H4: OUT PP, &H0: 'le PIC est reset‚

'tailleprog a la taille r‚ellement utilis‚e par l'application, maxi=1024.
FOR n = 0 TO tailleprog - 1:
  NumN$ = "   " + STR$(n): NumN$ = MID$(NumN$, LEN(NumN$) - 3)
  PRINT NumN$; : PRINT ":";
  'sortie data de commande m‚moire programme
  REGDECCOMMAND = CHPM: GOSUB ecrit6bits:
  REGDECDATA = bufprog(n) 'saisie valeur dans le buffer programme
  REGDATALEN = 4
  GOSUB ECRIT14BITS:  'Sortie mot de 14 bits vers port parallŠle

  '‚criture commande d‚but programmation
  REGDECCOMMAND = Debutprog: GOSUB ecrit6bits:

  V = TIMER:  'pour tempo de 10 ms.
bou5: IF TIMER < V + .02 THEN GOTO bou5:       'tempo 10mS

  REGDECCOMMAND = INCADR: GOSUB ecrit6bits:   'incr‚mentation adresse
NEXT n
' --------------- fin d'‚criture en m‚moire programme ---------------------



'------------------ ‚criture en m‚moire eeprom ----------------------------
ecritdataeeprom:
PRINT
'‚criture des datas en eeprom

PRINT
IF Lang = 1 THEN
  PRINT "Ecriture des datas en eeprom: "
ELSE
  PRINT "Writing data into EEPROM: "
END IF

OUT PP, &H0: OUT PP, &H4: OUT PP, &H0: 'le PIC est reset‚

FOR n = 0 TO 63
  NumN$ = "   " + STR$(n): NumN$ = MID$(NumN$, LEN(NumN$) - 3)
  PRINT NumN$; : PRINT ":";

  'Sortie du mot de contr“le ecriture vers eeprom
  REGDECCOMMAND = ECRITDATAMEM: GOSUB ecrit6bits:

  REGDECDATA = bufdataeeprom(n) 'saisie valeur dans le buffer datas eeprom
  REGDATALEN = 2
  GOSUB ECRIT14BITS:  'Sortie mot de 14 bits vers port parallŠle

  '‚criture commande d‚but programmation
  REGDECCOMMAND = Debutprog: GOSUB ecrit6bits:

  V = TIMER:  'tempo
  WHILE TIMER < V + .02: WEND  'tempo = 10mS

  REGDECCOMMAND = INCADR: GOSUB ecrit6bits 'incr‚mentation adresse
NEXT n
' --------------- fin d'‚criture en m‚moire eeprom ------------------------




'----------------------------------FIN--------------------------------------
fin:
CLOSE #1
OUT PP, &H4: 'maintien de la broche reset MCLR … niveau bas
PRINT : PRINT
IF Lang = 1 THEN
  PRINT "Appuyez sur une touche pour continuer"
ELSE
  PRINT "To continue, press any key"
END IF
bou11: IF INKEY$ = "" THEN GOTO bou11
CLS
LOCATE 11, 1
IF Lang = 1 THEN
  PRINT "Retirez le 13V du programmateur, par le switch 13v on/off "
  PRINT "mais ne coupez pas le 5V, appuyez sur une touche pour reseter le pic."
ELSE
  PRINT "Remove the 13V from programmer by switching the 13V SWITCH to OFF "
  PRINT "but do NOT switch off the 5V. Press any key to reset the PIC."
END IF
bou8: IF INKEY$ = "" THEN GOTO bou8
OUT PP, 0
CLS
LOCATE 10, 1
IF Lang = 1 THEN
  PRINT "Ca y est, le pic est programm‚, si le programme test1 ou test2 est charg‚"
  PRINT "une led cƒbl‚e en rb0 ou rb1 doit clignoter."
  PRINT "Si le programme n'est pas un test, vous pouvez couper l'alimentation"
  PRINT "et placer le pic dans la carte cible."
ELSE
  PRINT "That's it. The PIC is programmed. In case you loaded one of the test programs"
  PRINT "test1.obj or test2.obj one of the LEDs connected to rb0 or rb1 should flash."
  PRINT "If your program is not a test, you may now switch off the power of the"
  PRINT "programmer, remove the PIC and place it into your design."
END IF
IF ida$ <> "" THEN
  PRINT
  IF Lang = 1 THEN
    PRINT "Votre identificateur est: ";
  ELSE
    PRINT "Your identifier is: ";
  END IF
  PRINT ida$; idb$; idc$; idd$
END IF
SYSTEM
END
'---------------------------------------------------------------------------




'--------------------------Sous routine ECRIT14BITS ------------------------
ECRIT14BITS:
FOR te = 1 TO 10: NEXT te
'Sous routine pour sortie sur port parallŠle d'un mot de 14 bits encadr‚
'd'un z‚ro devant et derriŠre.
'Le mot est d‚cal‚ 14 fois vers la droite, c'est le lsb qui va vers le port,
'et est valid‚ sur front descendant de l'horloge.
HexVal$ = "000" + HEX$(REGDECDATA)
HexVal$ = MID$(HexVal$, LEN(HexVal$) + 1 - REGDATALEN)
PRINT HexVal$; : PRINT " ";
OUT PP, &H2: OUT PP, &H0: 'Un z‚ro en tˆte du mot de 14bits
FOR I = 1 TO 14
  SORTIEVAR = (REGDECCOMMAND AND &H1)
  OUT PP, SORTIEVAR: 'Sortie maintenant sur port parallŠle.
  SORTIEVAR = (REGDECDATA AND &H1) OR &H2:
  'sortie du bit lsb du data, horloge haute.
  OUT PP, SORTIEVAR: 'Sortie maintenant sur port parallŠle.
  FOR te = 1 TO 10: NEXT te
  SORTIEVAR = SORTIEVAR AND &H1:  'sortie du lsb avec horloge basse.
  OUT PP, SORTIEVAR: 'Sortie maintenant sur port parallŠle.
  FOR te = 1 TO 10: NEXT te
  REGDECDATA = INT(REGDECDATA / 2): 'd‚calage … droite du data, un seul bit.
NEXT I
OUT PP, &H2: OUT PP, &H0: 'Un z‚ro en queue de data.
RETURN
'-----------------------Fin de sous routine --------------------------------



'---------------------Sous routine ECRIT6BITS ------------------------------
ecrit6bits:
FOR te = 1 TO 10: NEXT te
'Sous routine pour sortie sur port parallŠle d'un mot de commande de 6 bits.
FOR I = 1 TO 6:  'les mots de commande sont de 6 bits.
  SORTIEVAR = (REGDECCOMMAND AND &H1)
  OUT PP, SORTIEVAR: 'Sortie maintenant sur port parallŠle.
  SORTIEVAR = (REGDECCOMMAND AND &H1) OR &H2:
  FOR te = 1 TO 10: NEXT te
  'sortie du bit lsb du data, horloge haute.
  OUT PP, SORTIEVAR: 'Sortie maintenant sur port parallŠle.     
  FOR te = 1 TO 10: NEXT te
  SORTIEVAR = SORTIEVAR AND &H1:  'sortie du lsb avec horloge basse.
  OUT PP, SORTIEVAR: 'Sortie maintenant sur port parallŠle.      
  FOR te = 1 TO 10: NEXT te
  REGDECCOMMAND = INT(REGDECCOMMAND / 2): 'd‚calage … droite du data, un seul bit
NEXT I
RETURN
'------------------------ Fin de sous routine ------------------------------



'------------------ Sous routine mot de configuration ----------------------
ecritmotdeconfig:
'Ecriture mot de configuration … l'adresse 2007h
mot$ = MID$(D$, 10 + 2, 2) + MID$(D$, 10, 2)
PRINT
PRINT
IF Lang = 1 THEN
  PRINT "Ecriture du mot de configuration: ";
ELSE
  PRINT "Writing the configuration word: ";
END IF
OUT PP, &H0: OUT PP, &H4: OUT PP, &H0: 'Le PIC est reset‚

'envoi mot de contr“le de configuration
REGDECCOMMAND = ECRITCONF: GOSUB ecrit6bits:

REGDECDATA = VAL("&H" + mot$): '‚criture du mot de configuration
REGDATALEN = 4
GOSUB ECRIT14BITS

'Incrementation jusqu'… 0x2007
FOR n = 1 TO 7: REGDECCOMMAND = INCADR: GOSUB ecrit6bits: NEXT n:

REGDECCOMMAND = Debutprog: GOSUB ecrit6bits:  'D‚but de Programmation
V = TIMER: 'pour une tempo de 10ms
bou6: IF TIMER < V + .02 THEN GOTO bou6
RETURN
'------------------------ Fin de sous routine ------------------------------


'----------------------- Sous routine identificateur -----------------------
identificateur:
PRINT : PRINT
ida$ = MID$(D$, 10, 2)
ida = VAL("&H" + ida$): ida$ = CHR$(ida)
idb$ = MID$(D$, 14, 2)
idb = VAL("&H" + idb$): idb$ = CHR$(idb)
idc$ = MID$(D$, 18, 2)
idc = VAL("&H" + idc$): idc$ = CHR$(idc)
idd$ = MID$(D$, 22, 2)
idd = VAL("&H" + idd$): idd$ = CHR$(idd)
IF Lang = 1 THEN
  PRINT "Votre identificateur est: ";
ELSE
  PRINT "Your identifier is: ";
END IF
PRINT ida$ + idb$ + idc$ + idd$
PRINT
IF Lang = 1 THEN
  PRINT "Ecriture du mot d'identification: ";
ELSE
  PRINT "Writing the identification word: ";
END IF

OUT PP, &H0: OUT PP, &H4: OUT PP, &H0: 'Le PIC est reset‚

'‚criture du mot d'identification de 4 caractŠres … l'adresse 2000h
FOR n = 10 TO longueur - 2 STEP 4
  REGDECCOMMAND = ECRITCONF: GOSUB ecrit6bits:
  mot$ = MID$(D$, n + 2, 2) + MID$(D$, n, 2)
  REGDECDATA = VAL("&H" + mot$): 'Conversion en d‚cimal des valeurs hexa
  IF REGDECDATA < 256 THEN REGDATALEN = 2 ELSE REGDATALEN = 4
  GOSUB ECRIT14BITS
  REGDECCOMMAND = Debutprog: GOSUB ecrit6bits:  'D‚but de Programmation
  V = TIMER: 'pour une tempo de 10ms
bou10: IF TIMER < V + .02 THEN GOTO bou10
  REGDECCOMMAND = INCADR: GOSUB ecrit6bits:
NEXT n
RETURN
'------------------------ Fin de sous routine ------------------------------



'---------------------sous routine remplissage buffer programme ------------
remplirbufprog:
FOR n = 10 TO longueur - 2 STEP 4
  mot$ = MID$(D$, n + 2, 2) + MID$(D$, n, 2)
  mot = VAL("&H" + mot$): 'Conversion en d‚cimal des valeurs hexa
  bufprog(adresse) = mot
  adresse = adresse + 1
  tailleprog = adresse
NEXT n
RETURN
'------------------------ Fin de sous routine ------------------------------



'----------------------sous routine remplissage buffer datas en eeprom -----
remplirbufeeprom:
FOR n = 10 TO longueur - 2 STEP 4
  mot$ = MID$(D$, n + 2, 2) + MID$(D$, n, 2)
  mot = VAL("&H" + mot$): 'Conversion en d‚cimal des valeurs hexa
  bufdataeeprom(adresse - VAL("&H2100")) = mot
  adresse = adresse + 1
NEXT n
RETURN
'------------------------ Fin de sous routine ------------------------------



'----------------------subroutine check valid data range 8 or 14 bit--------
check8:
limit = 2 ^ 8 - 1
GOSUB checkit
RETURN

check14:
limit = 2 ^ 14 - 1
GOSUB checkit
RETURN

checkit:
FOR n = 1 TO words
  IF VAL("&H" + MID$(D$, 8 + 4 * n, 2) + MID$(D$, 6 + 4 * n, 2)) > limit THEN
    CKRES = CKRES + 1
  END IF
NEXT n
RETURN
'------------------------ Fin de sous routine ------------------------------

'-------------- Subroutine INPUT #1, D$ -- geht auch bei fehlendem CR ------
ReadD:
D$ = ""
DO
  D0$ = INPUT$(1, #1)
  IF D0$ = CHR$(13) THEN D0$ = ""
  IF D0$ = CHR$(10) THEN EXIT DO
  D$ = D$ + D0$
LOOP
RETURN
'------------------------ Fin de sous routine ------------------------------