1 REM IBM disc dump utility program by Mark Holmes
   10 REM Main program loop
   20 MODE7
   30 DIM buffer &1500
   40 buffer=(buffer+&FF) AND &FF00
   50 PROCsetup
   60 REPEAT
   70     PROCprompt("Press D(ir), F(iledump) or Q(uit)")
   80     K%=GET AND &DF
   90     IF K%=ASC"D":PROCdisplay_directory
  110     IF K%=ASC"F":PROCfile_dump
  120 UNTIL K%=ASC"Q"
  130 MODE7
  140 END
  200 REM Print out IBM disc directory
  210 DEFPROCdisplay_directory
  220 CLS
  230 cluster=FNget_dir("display directory")
  240 ENDPROC
  300 REM Dump contents of file to screen
  310 DEFPROCfile_dump
  320 VDU 28,3,24,39,24,12
  330 INPUT TAB(4);"Enter Filename: "name$
  340 VDU 28,0,23,39,2
  350 PROCprompt(name$)
  360 CLS
  370 cluster=FNget_dir(FNname_convert(name$))
  380 IF cluster=-1:PRINT TAB(10,5);name$;" not found":PROCprompt("Press any key to continue"):K%=GET:ENDPROC
  390 IF cluster=0:PRINT TAB(10,5);name$;" has no data":PROCprompt("Press any key to continue"):K%=GET:ENDPROC
  400 block_address%=0
  410 REPEAT
  420     PROCconvert(cluster)
  430     cluster=FNnext_cluster(cluster)
  440     PROCdump(buffer,&200,block_address%)
  450     block_address%=block_address%+&200
  460 UNTIL cluster>&FEF
  470 ENDPROC
  500 REM Loop until WD1770 is not busy
  510 DEFPROCwait
  520 REPEAT:UNTIL((?status_reg) AND busy_bit)<>1
  530 ENDPROC
  600 REM read sector from disc
  610 DEFPROCread_sector(side,track,sector,address)
  620 IF address<>0:?(save+1)=address MOD 256:?(save+2)=address DIV 256
  630 IF side=1:value=(value OR &10) ELSE value=(value AND &EF)
  640 ?dr_ctrl_reg=value
  650 ?data_reg=track
  660 ?comm_reg=&19
  670 PROCwait
  680 ?track_reg=track DIV double
  690 ?sector_reg=sector
  700 ?comm_reg=&84
  710 PROCwait
  720 IF ((?status_reg) AND error_bit)=&10:PRINT"DATA ERROR: ";side;" ";track;" ";sector:END
  730 ?track_reg=track
  740 ENDPROC
  800 REM Initialise disc drive control register
  810 DEFPROCdisc_init(drive,side,density)
  820 value=4
  830 IF drive=1:value=value+2 ELSE value=value+1
  840 IF side=1:value=value+&10
  850 IF density<>2:value=value+&20
  860 ?dr_ctrl_reg=value
  870 ?comm_reg=&09
  880 PROCwait
  890 ENDPROC
  900 REM Search for filename in directory
  910 DEFFNget_dir(search$)
  920 I=dir_buffer
  930 REPEAT
  940     IF ?I<>&E5:B=FNshow_name
  950     I=I+32
  960 UNTIL (I=dir_buffer+112*32) OR (?I=0) OR B<>-1
  970 =B
 1000 REM Compare search name to directory entry,
 1001 REM Return cluster number or -1 if no file or 0 if empty file
 1010 DEFFNshow_name
 1020 fname$=""
 1030 FOR J=0 TO 10
 1040     fname$=fname$+CHR$(I?J)
 1050 NEXT
 1060 fat=(I!26) AND &FFFF
 1070 IF search$="display directory":PRINTLEFT$(fname$,8);".";RIGHT$(fname$,3);"  ";
 1080 IF POS=2:VDU 13
 1090 IF fname$=search$:=fat ELSE =-1
 2000 REM Return next cluster from file allocation table
 2010 DEFFNnext_cluster(start)
 2020 fat_entry=fat_buffer!((start DIV 2)*3)
 2030 byte1=fat_entry AND &FF
 2040 byte2=(fat_entry AND &FF00)/&100
 2050 byte3=(fat_entry AND &FF0000)/&10000
 2060 IF start MOD 2=0:=byte1+((byte2 AND &F)*&100)
 2070 IF start MOD 2=1:=byte2/&10+(byte3*&10)
 3000 REM convert cluster number to physical disc location
 3010 DEFPROCconvert(cluster_no)
 3020 log_sector =(cluster_no-2)*2+12
 3030 phys_side  =(log_sector DIV 9) MOD 2
 3040 log_track  =(log_sector DIV (9 * 2))
 3050 phys_sector=(log_sector MOD 9) + 1
 3060 PROCread_sector(phys_side,log_track,phys_sector,buffer)
 3070 ENDPROC
 4000 REM dump data to screen
 4010 DEFPROCdump(where%,how_much%,file_offset%)
 4020 FOR I%=where% TO where%+how_much%-8 STEP 8
 4030     @%=6
 4040     PRINT CHR$(129);~file_offset%+I%-where%,CHR$(135);
 4050     @%=1
 4060     FOR J%=0 TO 7
 4070         PRINT ~(I%?J% AND &F0)/&10,~I%?J% AND &F," ";
 4080     NEXT
 4090     PRINT CHR$(8);CHR$(131);
 4100     FOR J%=0 TO 7
 4110         IF (I%?J%>31) AND (I%?J%<127):PRINTCHR$(I%?J%); ELSE PRINT".";
 4120     NEXT
 4130     PRINT
 4140 NEXT
 4150 ENDPROC
 5000 REM Set up variables, load directory and fat etc.
 5010 DEFPROCsetup
 5011 A%=0:X%=1:A%=((USR&FFF4)AND&FF00)DIV256
 5012 machine$="MASTER":IFA%=2:machine$="B+"
 5020 IF A%>2:dr_ctrl_reg=&FE24 ELSE dr_ctrl_reg=&FE80
 5030 IF A%>2:WD1770_addr=&FE28 ELSE WD1770_addr=&FE84
 5040 comm_reg=WD1770_addr
 5050 status_reg=WD1770_addr
 5060 track_reg=WD1770_addr+1
 5070 sector_reg=WD1770_addr+2
 5080 data_reg=WD1770_addr+3
 5090 busy_bit=&01
 5100 error_bit=&10
 5110 FOR opt%=0 TO 2 STEP 2
 5120   P%=&D00        :REM NMI adress
 5140   [OPT opt%
 5160         PHA            \ save accumulator on stack
 5170         LDA status_reg \ get status register value
 5180         AND #&1F       \ mask out unwanted bits
 5190         CMP #&03       \ data ready & busy bits
 5200         BNE exit       \ not interested in NMI
 5210         LDA data_reg   \ get data from data register
 5220   .save STA &2000      \ store data
 5230         INC save+1     \ increment sabe adress LSB
 5240         BNE &0D18      \ not page boundary so exit
 5250         INC save+2     \ increment save adress MSB
 5560   .exit PLA            \ restore accumulator
 5270         RTI            \ return from interrupt
 5320 ]:NEXT opt%
 5350 VDU23,1;0;0;0;0
 5360 PRINT CHR$(135);CHR$(157);CHR$(132);CHR$(141);
 5400 PRINT TAB(8);"IBM disc dump utility"
 5410 PRINT CHR$(135);CHR$(157);CHR$(132);CHR$(141);
 5420 PRINT TAB(8);"IBM disc dump utility"
 5430 PRINT TAB(0,24);CHR$(135);CHR$(157);CHR$(132);
 5440 PRINT TAB(0,23);CHR$(135);CHR$(157);CHR$(132);
 5450 PROCprompt("Press any key to continue")
 5460 VDU28,0,23,39,2,12
 5470 PRINT TAB(5,5);"Put IBM format disc in drive 0"
 5480 K%=GET
 5490 CLS
 5500 fat_buffer=buffer+&200
 5510 dir_buffer=buffer+&200+&400
 5520 drive=0:density=2:side=0:double=1
 5530 PROCdisc_init(drive,side,density)
 5531 PROCread_sector(0,0,1,fat_buffer)
 5532 dir=1 + fat_buffer?16 * fat_buffer?22
 5533 IF fat_buffer?21>&F9:double=2
 5540 PROCread_sector(0,0,2,fat_buffer)
 5550 PROCread_sector(0,0,3,0)
 5560 PROCread_sector(0,0,4,0)
 5570 PROCread_sector(0,0,5,0)
 5580 PROCread_sector((dir+0) DIV 9,0,((dir+0) MOD 9)+1,dir_buffer)
 5590 PROCread_sector((dir+1) DIV 9,0,((dir+1) MOD 9)+1,0)
 5600 PROCread_sector((dir+2) DIV 9,0,((dir+2) MOD 9)+1,0)
 5610 PROCread_sector((dir+3) DIV 9,0,((dir+3) MOD 9)+1,0)
 5620 PROCread_sector((dir+4) DIV 9,0,((dir+4) MOD 9)+1,0)
 5630 PROCread_sector((dir+5) DIV 9,0,((dir+5) MOD 9)+1,0)
 5640 PROCread_sector((dir+6) DIV 9,0,((dir+6) MOD 9)+1,0)
 5650 ENDPROC
 6000 REM Place message at bottom of screen
 6010 DEFPROCprompt(message$)
 6020 VDU 28,3,24,39,24,12
 6030 PRINT TAB((34-LEN(message$))/2,0);message$;
 6040 VDU 28,0,23,39,2
 6050 ENDPROC
 7000 REM Convert filename into directory format
 7010 DEFFNname_convert(string_in$)
 7020 I%=INSTR(string_in$+".",".")
 7030 string_out$=LEFT$(LEFT$(string_in$,I%-1)+STRING$(9-I%," "),8)
 7040 string_out$=string_out$+LEFT$(MID$(string_in$,I%+1)+"  ",3)
 7050 =string_out$
 7060 GOTO7060

Download IBMREADER

BBC BASIC detokeniser and syntax highlighter by Ben Ryves.