DEFLNG a
DEFINT b-z

DIM cfarray(6)
DIM result(8) :         REM Result after error
DIM databuffer(512)
DIM errortrack(100) :   REM Error list

DIM DriveName$(32) :    REM Manufactures Name
DIM DriveCyl(32) :      REM Number of Cylinders
DIM DrivePre(32) :      REM 1st Cylinder for Precomp.
DIM DriveHead(32) :     REM Number of Heads
DIM DriveStep(32) :     REM Steprate

numcyl = 0 :            REM Working parameters for drive
redcurr = 0
wrtprecomp = 0
numhead = 0
steprate = -1
dname$ = ""
ver$ = "V3.04 21/04/90"

startcyl = 0
werror = 0

addr = 15599169& :' $EE0641 : REM Start address for XT Controller
adrstatus = addr+2
adrselect = addr+4
adrmask   = addr+6

REM =========================================================

MFMDrives:
DATA 24
DATA "Maxtor XT1140",         918,  918, 15, 1
DATA "CMI 6426",              640,  256,  4, 1
DATA "Rodime 352",            306,  306,  4, 1
DATA "Microscience HH312",    306,  306,  4, 1
DATA "Seagate ST4026",        615,  300,  4, 1
DATA "Cynthia 570",           987,  987,  7, 1
DATA "Vertex V170",           987,  987,  7, 1
DATA "Seagate ST4038",        733,  300,  5, 1
DATA "Seagate ST213",         612,  256,  2, 1
DATA "Miniscribe 3425",       612,  128,  4, 1
DATA "Quantum Q540",          512,  256,  8, 1
DATA "Seagate ST4051",        977,  300,  5, 1
DATA "CMI 342",               612,  256,  4, 1
DATA "Seagate ST225",         612,  256,  4, 1
DATA "CDC 9415-36",           697,  256,  5, 1
DATA "CMI 3212",              612,  128,  2, 1
DATA "Miniscribe 3012/3212",  612,  128,  2, 1
DATA "CMI 6640",              640,  256,  6, 1
DATA "Tulin 240",             640,  256,  6, 1
DATA "CMI 5412",              306,  128,  4, 1
DATA "Lapine 3522",           306,  128,  4, 1
DATA "Otari 514",             306,  128,  4, 1
DATA "Seagate ST412/ST212",   306,  128,  4, 1
DATA "Shugart 712",           306,  128,  4, 1

RLLDrives:
DATA 21
DATA "Atasi 3085",           1024, 1024,  8, 1
DATA "Miniscribe 8438",       612,  612,  4, 1
DATA "Microscience HH330",    612,  612,  4, 1
DATA "Microscience HH738",    612,  612,  4, 1
DATA "Peripheral Tech 357R",  615,  615,  6, 1
DATA "Lapine LT300",          616,  616,  4, 1
DATA "Priam V170",            987,  987,  7, 1
DATA "Priam V185",           1166, 1166,  7, 1
DATA "Priam 514",            1224, 1224, 11, 1
DATA "Priam 519",            1224, 1224, 15, 1
DATA "Seagate ST251R",        820,  820,  4, 1
DATA "Seagate ST277R",        820,  820,  6, 1
DATA "Seagate ST4077R",      1024, 1024,  5, 1
DATA "Seagate ST4144R",      1024, 1024,  9, 1
DATA "Toshiba MK53FB",        830,  830,  5, 1
DATA "Toshiba MK54FB",        830,  830,  7, 1
DATA "Toshiba MK56FB",        830,  830, 10, 1
DATA "Seagate ST238R",        615,  615,  4, 1
DATA "Miniscribe 3438",       615,  615,  4, 1
DATA "Fujitsu M2226D",        615,  615,  6, 1
DATA "Fujitsu M2227D",        615,  615,  8, 1

REM =========================================================

'WINDOW 1,, (0,0)-(637,186)

CLS
PRINT "Low Level Format program ";ver$;"    Controller address $";hex$(addr)
COLOR 3 : BEEP
PRINT "Warning !!! All Data will be erased on hard disk ...If in doubt ^C or reboot."
PRINT 
COLOR 1

WHILE UCASE$(type$) <> "MFM" AND UCASE$(type$) <> "RLL"
  LOCATE 4, 1
  INPUT "Enter Controller type (MFM or RLL) "; type$
WEND
IF UCASE$(type$) = "RLL" THEN
  numsec = 26
  RESTORE RLLDrives
ELSE
  numsec = 17
  RESTORE MFMDrives
END IF

READ imax : REM Number of drives in MFM/RLL lists
FOR i=0 TO imax-1
  READ DriveName$(i), DriveCyl(i), DrivePre(i), DriveHead(i), DriveStep(i)
NEXT i

unit = -1
WHILE unit < 0 OR unit > 1
  LOCATE 6, 1
  INPUT "Enter unit to be formatted (0..1) ",unit
WEND
lun = unit * 32 ' lun is logical unit

CALL SelectDriveType(imax)
CALL GetDriveData
endcyl = numcyl

CLS
PRINT USING "Drive #: & has #### Cylinders  ## Heads"; unit, dname$, numcyl, numhead
CALL Fixdefect

lasttrack = (numcyl * numhead) - 1 : REM Last available track
maxtrack = lasttrack

PRINT : BEEP
PRINT  "Format starts at cylinder "; startcyl; "and ends at "; lasttrack\numhead
PRINT  "Ready to start the Format? (Y/N) ";
jn$ = INPUT$(1)
IF UCASE$(jn$) <> "Y" THEN END


CALL SetChar : REM Set Drive Characteristics

CLS : PRINT "Starting..."
PRINT "Recalibrating the drive"
CALL Recalibrate
PRINT "Formatting"
CALL formatdrive(startcyl)
PRINT "Format complete"


IF defect THEN
  PRINT : PRINT  "Defects detected, allocating spare sectors :"
  FOR i=0 TO defect-1
    defectCyl = errortrack(i)\numhead
    defectHead = errortrack(i) MOD numhead
    NewCyl = lasttrack\numhead
    NewHead = lasttrack MOD numhead
    CALL AltTrack( defectCyl, defectHead, NewCyl, NewHead, lasttrack)
  NEXT i
END IF


IF (lasttrack MOD numhead) THEN
  endcyl = (lasttrack\numhead)-1
ELSE
  endcyl = lasttrack\numhead
END IF

PRINT : PRINT  "Verifying the format"
  PRINT "CYLINDER      HEAD"
FOR cyl=startcyl TO endcyl
  FOR head=0 TO numhead-1
    LOCATE ,1
    PRINT   cyl, head;
    CALL check(cyl, head)
    WHILE werror <> 0
      PRINT  " ERROR ";
      FOR i=0 TO 4 : PRINT  HEX$(result(i)); " "; : NEXT
      PRINT
      werror = 0
      NewCyl = lasttrack\numhead
      NewHead = lasttrack MOD numhead
      defect = defect + 1
      CALL AltTrack( cyl, head, NewCyl, NewHead, lasttrack)
      IF (lasttrack MOD numhead) THEN endcyl = (lasttrack\numhead)-1 ELSE endcyl = lasttrack\numhead
    WEND
  NEXT head
NEXT cyl
PRINT  : PRINT  "Verification finished."

Rem New drive data will be written to sector 0 on cuurent drive
REM this is used by the driver to recognise for initialisation.
CALL SaveDriveData(endcyl+1, redcurr, wrtprecomp, numhead, steprate)

IF lasttrack < maxtrack THEN
   PRINT : PRINT "ATTENTION: Drives defective sectors have altered total usable cylinders"
END IF

TOENDORNOT:
LOCATE ,1
   COLOR 3 : PRINT "The high cylinder number is "; endcyl : COLOR 1
   PRINT "This value is for the HighCyl in the mountlist"
   PRINT "(This is the end of the Program)"
  PRINT  "TO QUIT TYPE Q ";
    jn$ = INPUT$(1)
  IF UCASE$(jn$) <> "Q" THEN TOENDORNOT
END


REM =========================================================


SUB AltTrack( cyl, head, altcyl%, althead%, lasttrack ) STATIC
SHARED numhead

form$ = "Creating Alternate Track : ####_/## ==> ####_/##"
defecttrack = cyl*numhead + head

IF defecttrack < lasttrack THEN
   PRINT USING form$; cyl, head, altcyl%, althead%
   CALL AssignAltTrack( cyl, head, altcyl%, althead%)
END IF
lasttrack = lasttrack - 1

END SUB



REM =========================================================
SUB waitready STATIC
SHARED adrstatus

WHILE (PEEK(adrstatus) AND 1) <> 1 : WEND
END SUB




REM =========================================================
SUB sendcommand STATIC
SHARED addr, adrselect,cfarray()

POKE adrselect,0
FOR i=0 TO 5
  waitready
  POKE addr, cfarray(i)
NEXT

END SUB



REM =========================================================
SUB readresult STATIC
SHARED addr, adrstatus, result()

FOR i=0 TO 4
  waitready
  IF i=3 THEN
     result(i) = result(i)+ PEEK(addr)
  ELSE
     result(i) = PEEK(addr)
  END IF
  IF i=2 THEN
     IF result(i) >= 64 THEN
       result(i+1) = (result(i) / 64) * 256
     ELSE
       result(i+1) = 0
     END IF
  END IF
NEXT i
END SUB


REM =========================================================
SUB errorcheck STATIC
SHARED addr, adrstatus, cfarray(), werror, lun

werror = 0
waitready
status = PEEK(addr)
IF (status AND 2) <> 0 THEN
  werror = 1
  cfarray(0) = 3
  cfarray(1) = 0 OR lun
  cfarray(2) = 0
  cfarray(3) = 0
  cfarray(4) = 0
  cfarray(5) = 0
  sendcommand
  readresult
  PRINT " Error #"; HEX$(cfarray(0) AND &H30)
END IF

END SUB


REM =========================================================
SUB SetChar STATIC
SHARED cfarray(), addr, adrstatus, adrmask, lun, numcyl, numhead

DIM charac(8)

charac(0) = ((numcyl-2) \ &HFF) AND &H3
charac(1) = (numcyl-2) MOD &HFF
charac(2) = numhead AND &H1F
charac(3) = charac(0)      : ' reduced write current
charac(4) = charac(1)
charac(5) = charac(0)      : ' Write precompensation
charac(6) = charac(1)
charac(7) = 0

POKE adrstatus, 0 : ' reset
POKE adrmask, 0 : ' Interrupt-Mask 0

cfarray(0) = 12
cfarray(1) = 0 OR lun
cfarray(2) = 0
cfarray(3) = 0
cfarray(4) = 0
cfarray(5) = 0
sendcommand
FOR i=0 TO 7
  waitready
  POKE addr, charac(i)
NEXT i
errorcheck

ERASE charac
END SUB


REM =========================================================
SUB formatdrive(startc) STATIC
SHARED cfarray(), lun, interleave, steprate

cfarray(0) = 4
cfarray(1) = ((startc\16) AND &H80) OR lun
cfarray(2) = (startc\4) AND &HC0
cfarray(3) = startc AND &HFF
cfarray(4) = interleave AND &H1F
cfarray(5) = steprate AND &H3
sendcommand
errorcheck
END SUB


REM =========================================================
SUB formattrack(cyl, head) STATIC
SHARED cfarray(),lun, interleave, steprate

cfarray(0) = 6
cfarray(1) = ((cyl\16) AND &H80) OR lun OR (head AND &H1F)
cfarray(2) = (cyl\4) AND &HC0
cfarray(3) = cyl AND &HFF
cfarray(4) = interleave AND &H1F
cfarray(5) = steprate AND &H7
sendcommand
errorcheck

END SUB



REM =========================================================
SUB formatbadtrack(cyl, head) STATIC
SHARED cfarray(),lun, interleave, steprate

cfarray(0) = 7
cfarray(1) = ((cyl\16) AND &H80) OR lun OR (head AND &H1F)
cfarray(2) = (cyl\4) AND &HC0
cfarray(3) = cyl AND &HFF
cfarray(4) = interleave AND &H1F
cfarray(5) = steprate AND &H7
sendcommand
errorcheck

END SUB



REM =========================================================
SUB AssignAltTrack(cyl, head, altcyl%, althead%) STATIC
SHARED cfarray(),lun, interleave, steprate, addr, adrstatus

DIM atdat%(4)

IF (cyl < startcyl OR altcyl% < startcyl) THEN
     PRINT "Cylinder is now : "; cyl, altcyl
     STOP
END IF
cfarray(0) = &H11
cfarray(1) = ((cyl\16) AND &H80) OR lun OR (head AND &H1F)
cfarray(2) = (cyl\4) AND &HC0
cfarray(3) = cyl AND &HFF
cfarray(4) = interleave AND &H1F
cfarray(5) = steprate AND &H7

atdat%(0) = ((altcyl%\16) AND &H80) OR (althead% AND &H1F)
atdat%(1) = (altcyl%\4) AND &HC0
atdat%(2) = altcyl% AND &HFF
atdat%(3) = 0

sendcommand
status = PEEK(adrstatus)
IF (status AND 4) = 0 THEN
  FOR i=0 TO 3
    waitready
    POKE addr, atdat%(i)
  NEXT i
END IF
errorcheck

ERASE atdat%
END SUB



REM =========================================================
SUB seek(track) STATIC
SHARED cfarray(), lun, steprate

cfarray(0) = &HB
cfarray(1) = ((track\16) AND &H80) OR lun
cfarray(2) = (track\4) AND &HC0
cfarray(3) = track AND &HFF
cfarray(4) = 0
cfarray(5) = steprate AND &H7
sendcommand
errorcheck
END SUB


REM =========================================================
SUB Recalibrate STATIC
SHARED cfarray(), lun, steprate

cfarray(0) = &HB
cfarray(1) = lun
cfarray(2) = 0
cfarray(3) = 0
cfarray(4) = 0
cfarray(5) = steprate AND &H7
sendcommand
errorcheck
END SUB


REM =========================================================
SUB check(track, head) STATIC
SHARED cfarray(), numsec, lun, steprate

cfarray(0) = 5
cfarray(1) = 0 OR lun
cfarray(2) = (track\4) AND &HC0
cfarray(3) = track AND &HFF
cfarray(4) = numsec AND &HFF
cfarray(5) = steprate AND &H7
sendcommand
errorcheck
END SUB



REM =========================================================
SUB writesector(cyl, head, sect, buffer(1) ) STATIC
SHARED cfarray(), adrstatus, addr, lun, steprate

cfarray(0) = &HA
cfarray(1) = ((cyl\16) AND &H80) OR lun OR head
cfarray(2) = ((cyl \ 4) AND &HC0) OR (sect AND &H3F)
cfarray(3) = cyl AND &HFF
cfarray(4) = 1
cfarray(5) = steprate AND &H7
sendcommand
waitready
status = PEEK(adrstatus)
IF (status AND 4) = 0 THEN
  waitready
  FOR i=0 TO 511
    POKE addr, buffer(i)
  NEXT i
END IF
errorcheck

END SUB


REM =========================================================
SUB readsector(cyl, head, sect, buffer(1) ) STATIC
SHARED cfarray(), adrstatus, addr, lun, steprate

cfarray(0) = &H8
cfarray(1) = ((cyl\16) AND &H80) OR lun OR head
cfarray(2) = ((cyl\4) AND &HC0) OR (sect AND &H3F)
cfarray(3) = cyl AND &HFF
cfarray(4) = 1
cfarray(5) = steprate AND &H7
sendcommand
waitready
status = PEEK(adrstatus)
IF (status AND 4) = 0 THEN
  waitready
  FOR i=0 TO 511
    buffer(i) = PEEK(addr)
  NEXT i
END IF
errorcheck

END SUB


REM =========================================================
SUB dumpdata(ddata(1), dlen) STATIC

FOR i=0 TO dlen/16
  FOR j=0 TO 15
    h$ = HEX$(ddata(j+16*i))
    WHILE LEN(h$) < 2 : h$ = "0"+h$ : WEND
    PRINT  USING "\\ "; h$;
  NEXT
  PRINT
NEXT

END SUB



REM =========================================================

REM Enter drive details manually

SUB GetDriveData STATIC

SHARED numcyl, redcurr, wrtprecomp, numhead, steprate, numsec, interleave

CLS
WHILE numcyl < 1 OR numcyl > 2048
  LOCATE 3, 1
  PRINT "HOW MANY CYLINDERS (1..2048)                        ";
  INPUT ;numcyl
WEND
WHILE redcurr < 1 OR redcurr > numcyl
  LOCATE 4, 1
  PRINT USING "Start Reduced write current at cyl(1_._.####) "; numcyl
  LOCATE 4, 53
  INPUT ;redcurr : IF redcurr = 0 THEN redcurr = numcyl
WEND
WHILE wrtprecomp < 1 OR wrtprecomp > numcyl
  LOCATE 5, 1
  PRINT USING "Start Write Precompensation       (1_._.####) "; numcyl
  LOCATE 5, 53
  INPUT ;wrtprecomp : IF wrtprecomp = 0 THEN wrtprecomp = numcyl
WEND

WHILE numhead < 1 OR numhead > 16
  LOCATE 6, 1
  INPUT "How many heads                              (1..16) "; numhead
WEND

WHILE numsec <> 17 AND numsec <> 26
  LOCATE 7, 1
  INPUT "How many sectors per track               (17 or 26) "; numsec
WEND
WHILE interleave < 1 OR interleave > numsec
  LOCATE 8, 1
  PRINT USING "Sector Interleave Factor            (1_._.##) "; numsec -1;
  INPUT interleave
WEND

WHILE steprate <0 OR steprate > 7
  LOCATE 11, 1 : PRINT "Step Rate"
  LOCATE 12, 1 : PRINT " 0 = 3ms     1 = 10µs     2 = 25µs"
  LOCATE 13, 1 : PRINT " 3 = 50µs    4 = 200µs    5 = 70µs"
  LOCATE 14, 1 : PRINT " 6 = 3ms     7 = 3ms"
  LOCATE 15, 1
  INPUT "Step Rate                                    (0..7) ", steprate
WEND

END SUB




REM =========================================================

REM Drive data written at Cylinder 0, Head 0, Sector 0 
SUB SaveDriveData(numcyl, redcurr, wrtprecomp, numhead, steprate) STATIC

DIM databuffer%(512)

PRINT "Drive data is being stored...";

CALL readsector(0, 0, 0, databuffer() )

databuffer(18) = numcyl \ 256
databuffer(19) = numcyl MOD 256
databuffer(20) = redcurr \ 256
databuffer(21) = redcurr MOD 256
databuffer(22) = wrtprecomp \ 256
databuffer(23) = wrtprecomp MOD 256
databuffer(24) = numhead \ 256
databuffer(25) = numhead MOD 256
databuffer(26) = steprate \ 256
databuffer(27) = steprate MOD 256

FOR i=28 TO 79 : databuffer(i) = 0 : NEXT

cks& = 0 : REM Checksum is calculated
FOR i=18 TO 79 STEP 2
  cks& = cks& + 256*databuffer(i) + databuffer(i+1)
  cks& = cks& AND &HFFFF
NEXT

cks$ = HEX$(&H55AA-cks&)
WHILE LEN(cks$)<4 : cks$ = "0"+cks$ : WEND
databuffer(16) = VAL("&h"+LEFT$(cks$, 2))
databuffer(17) = VAL("&h"+MID$(cks$, 3))

PRINT : PRINT "This is what I wrote !" : CALL dumpdata(databuffer%(), 128)

CALL writesector(0, 0, 0, databuffer() )

PRINT "All done......."

END SUB




REM =========================================================

SUB SelectDriveType(maxdrive) STATIC

SHARED DriveName$(), DriveCyl(), DrivePre(), DriveHead(), DriveStep()
SHARED numcyl, redcurr, wrtprecomp, numhead, steprate, dname$

CLS
PRINT "Enter number of drive or RETURN for more else enter 99 to manualy set data "

frm$ = "##_. \                        \  #### Cylinder  ## Heads"
ianf = 0

WHILE nr <> 99
  iend = ianf + 9
  FOR i=ianf TO iend
    LOCATE i-ianf+3, 1
    IF i < maxdrive THEN
      PRINT USING frm$; i+1, DriveName$(i), DriveCyl(i), DriveHead(i);
    ELSE
      PRINT SPACE$(78);
    END IF
  NEXT i
  LOCATE 16, 1 : INPUT "(Enter number or RETURN (for more drives) "; nr
  IF nr = 0 THEN
    IF iend <= maxdrive THEN
      ianf = iend + 1
    ELSE
      ianf = 0
    END IF
  END IF
  IF nr >= ianf+1 AND nr <= maxdrive THEN
      dname$ = DriveName$(nr-1)
      numcyl = DriveCyl(nr-1)
      redcurr = DrivePre(nr-1)
      wrtprecomp = DrivePre(nr-1)
      numhead = DriveHead(nr-1)
      steprate = DriveStep(nr-1)
      nr = 99
  END IF
WEND

END SUB




REM =========================================================

SUB Fixdefect STATIC

SHARED numcyl, numhead, errortrack(), defect

a$ = " "
PRINT : PRINT
PRINT  "Input Defects in Cyl,Head,Byte or in Head,Cyl,Byte order (C/H) ";
a$ = INPUT$(1)
cylvorn = UCASE$(a$) = "C"
IF cylvorn THEN
 CHB$ = "C,H,B"
ELSE
 CHB$ = "H,C,B"
END IF


PRINT : PRINT
PRINT  "Use defect list from error file ?"
PRINT  "Filename for Defect list (or <Return> for Manual entry) ";
LINE INPUT defectfilename$
PRINT
defectfile = 0
IF defectfilename$ <> "" THEN
  PRINT
  OPEN "I", 1, defectfilename$
  defectfile = -1
END IF


PRINT
PRINT  "Enter as "; CHB$; ", End with RETURN on blank line"
i=0
WHILE a$ <> ""
  PRINT USING "##_.) "; i+1;
  IF defectfile THEN
      LINE INPUT #1,a$
      PRINT a$
  ELSE
      LINE INPUT a$
  END IF
  IF a$ <> "" THEN
    pos1 = INSTR(a$, ",")
    pos2 = INSTR(pos1+1, a$, ",")
    zahl1 = VAL( LEFT$(a$, pos1-1) )
    zahl2 = VAL( MID$(a$, pos1+1, pos2-pos1-1) )
    zahl3 = VAL( MID$(a$, pos2+1) )
    IF cylvorn THEN
      cyl = zahl1
      head = zahl2
    ELSE
      cyl = zahl2
      head = zahl1
    END IF

    ok = 1
    IF cyl < 0 OR cyl > numcyl THEN
      PRINT "Cylinder "; cyl; " Number out of range !"
      ok = 0
    END IF
    IF head < 0 OR head > numhead THEN
      PRINT "Head "; head; " Number out of range !"
      ok = 0
    END IF
    errortrack(i) = cyl*numhead + head
  END IF
  IF ok THEN i = i + 1
WEND

IF defectfile THEN CLOSE #1
IF i=0 THEN defect=0 ELSE defect=i-1  : REM Number defects

END SUB