CLS

   PRINT TAB(5); "******************************************************************"
   PRINT TAB(5); "** Questo programma crea un file binario da inserire  direttamente                     **"
   PRINT TAB(5); "** nella eprom.                                                                                                      **"
   PRINT TAB(5); "*****************************************************************"
   PRINT
   PRINT

    DIM loc$(3)
    DIM loca$(3)

    INPUT "Nome del file di input: "; mm$
    OPEN mm$ FOR INPUT AS #2

'*********creazione file per la eprom********************

    INPUT "Nome del file di output:  "; nn$
    OPEN nn$ FOR BINARY AS #1
    PRINT ""

    INPUT "Locazione iniziale di memoria in hex:  ", a$
    PRINT ""
    memo = 0
    FOR p = 1 TO 6
    B$ = MID$(a$, p, 1)
     GOSUB conv
    memo = memo + (16 ^ (5 - p + 1)) * B
    NEXT p

'*********indirizzo iniziale di memoria da inserire nell’header********************

    loca = 0
    FOR k = 1 TO 3
      l = k - 1
      j = 2 * l + 1
      loc$(k) = MID$(a$, j, 2)
    NEXT k
      FOR k = 1 TO 3
        FOR l = 1 TO 2
          B$ = MID$(loc$(k), l, 1)
          GOSUB conv
          loca = loca + (16 ^ (1 - l + 1)) * B
        NEXT l
        loca(k) = loca
        loca = 0
      NEXT k

;**************************************************

    add = memo - 1   'locazione di memoria iniziale in dec.-1
    elab = 1
    ctn = 0
    jj = 0
 

'***********inizio header********************************

5     IF ctn = 1 THEN
      aa$ = LTRIM$(CHR$(8)) 'Memory width = 8 bits
      jj = jj + 1
      PUT #1, jj, aa$
      aa$ = LTRIM$(CHR$(0))
      jj = jj + 1
      PUT #1, jj, aa$
      aa$ = LTRIM$(CHR$(0))
      jj = jj + 1
      PUT #1, jj, aa$
      aa$ = LTRIM$(CHR$(0))
      jj = jj + 1
      PUT #1, jj, aa$

      aa$ = LTRIM$(CHR$(248))
      jj = jj + 1
      PUT #1, jj, aa$   'Memory type = SWW = 11 , WCNT = 7
      aa$ = LTRIM$(CHR$(16))
      jj = jj + 1
      PUT #1, jj, aa$
      aa$ = LTRIM$(CHR$(0))
      jj = jj + 1
      PUT #1, jj, aa$
      aa$ = LTRIM$(CHR$(0))
      jj = jj + 1
      PUT #1, jj, aa$

      nn = n      'lunghezza del programma in decimali
      n = n / 4
      n$ = HEX$(n)
      size = LEN(n$)
      zero$ = STRING$(8 - size, "0")
      rec1$ = zero$ + n$
      GOSUB hexbyte

      aa$ = LTRIM$(CHR$(loca(3)))      'Program load starting address
      jj = jj + 1
      PUT #1, jj, aa$
      aa$ = LTRIM$(CHR$(loca(2)))
      jj = jj + 1
      PUT #1, jj, aa$
      aa$ = LTRIM$(CHR$(loca(1)))
      jj = jj + 1
      PUT #1, jj, aa$
      aa$ = LTRIM$(CHR$(0))
      jj = jj + 1
      PUT #1, jj, aa$
       END IF

'********************************************************
    DO WHILE NOT EOF(2)
        LINE INPUT #2, rec$  'Legge le voci contenute nel file.
        IF LEFT$(rec$, 1) <> "0" THEN GOTO 10
        IF RIGHT$(LEFT$(rec$, 12), 1) <> "0" THEN GOTO 10
        IF elab = 1 THEN PRINT "elaborazione in corso..."
        elab = 0
        old = add    'indirizzo precedente
        add$ = RIGHT$(LEFT$(rec$, 10), 8)        ' address.

'********conversione dell'indirizzo in decimale**********
add = 0
FOR k = 0 TO 7
B$ = RIGHT$(LEFT$(add$, k + 1), 1)
GOSUB conv
add = add + B * 16 ^ (7 - k)
NEXT k

'*************controllo sulla continuità degli indirizzi******

         new = add
         diff = new - old - 1
         IF diff <> 0 THEN
            FOR l = 1 TO 4 * diff
            VECT$ = LTRIM$(CHR$(0))    'riempimento delle locazioni di memoria prive di istruzioni
         IF ctn = 1 THEN
         jj = jj + 1
         PUT #1, jj, VECT$
         END IF
            n = n + 1
           NEXT l
           END IF
'*************************************************************

        rec1$ = RIGHT$(LEFT$(rec$, 21), 8)       'opcode

'************disposizione in byte*****************************
      GOSUB hexbyte
'********************************************************

10    LOOP

      CLOSE #1
      CLOSE #2
      IF ctn = 0 THEN
        ctn = 1
        add = memo - 1    'locazione di memoria iniziale in dec.-1
        OPEN mm$ FOR INPUT AS #2
        OPEN nn$ FOR BINARY AS #1
        GOTO 5
      END IF
      PRINT ""
      PRINT "Sono stati traslati"; nn + 16; "byte"
      PRINT "Le righe totali di programma sono"; (nn + 16) / 4;
      PRINT ""
      PRINT "Il file è stato prodotto"
      END

'**************inizio subroutines*********************

hexbyte:
        func$ = RIGHT$(rec1$, 2)         'subroutine per la suddivisione in byte
        GOSUB byte
        func$ = LEFT$(RIGHT$(rec1$, 4), 2)
        GOSUB byte
        func$ = RIGHT$(LEFT$(rec1$, 4), 2)
        GOSUB byte
        func$ = LEFT$(rec1$, 2)
        GOSUB byte
        RETURN

byte:
        B$ = RIGHT$(func$, 1)           'subroutine per la trasformazione dei byte esadecimali in decimali
        GOSUB conv
        NUM = B
        B$ = LEFT$(func$, 1)
        GOSUB conv
        NUM = NUM + B * 16
        NUM$ = LTRIM$(CHR$(NUM))
        IF ctn = 1 THEN
        jj = jj + 1
        PUT #1, jj, NUM$
        END IF
        n = n + 1
        RETURN
 

conv:
IF B$ = "0" THEN B = 0       'subroutine di conversione di un numero esadecimale in decimale
IF B$ = "1" THEN B = 1
IF B$ = "2" THEN B = 2
IF B$ = "3" THEN B = 3
IF B$ = "4" THEN B = 4
IF B$ = "5" THEN B = 5
IF B$ = "6" THEN B = 6
IF B$ = "7" THEN B = 7
IF B$ = "8" THEN B = 8
IF B$ = "9" THEN B = 9
IF B$ = "a" OR B$ = "A" THEN B = 10
IF B$ = "b" OR B$ = "B" THEN B = 11
IF B$ = "c" OR B$ = "C" THEN B = 12
IF B$ = "d" OR B$ = "D" THEN B = 13
IF B$ = "e" OR B$ = "E" THEN B = 14
IF B$ = "f" OR B$ = "F" THEN B = 15
RETURN