Initial Commit
fmt3.bas is the only tool needed to run the disk formatter. If using VICE, run: petcat -w2 -o fmt3.prg -- fmt3.bas to create the .prg file that can be read by VICE. Then you can load and save the code normally. In the future, look for a d64 or d81.
This commit is contained in:
parent
bb18ba9a3a
commit
91965273ae
512
src/fmt3.bas
Normal file
512
src/fmt3.bas
Normal file
|
|
@ -0,0 +1,512 @@
|
||||||
|
0 rem ***********************************************
|
||||||
|
1 rem fmt3.bas - c64 disk formatter
|
||||||
|
2 rem target: c64 / basic 2.0 / jiffydos
|
||||||
|
3 rem drives: 1541, 1581 (1571 runs in 1541 mode)
|
||||||
|
4 rem ***********************************************
|
||||||
|
5 rem
|
||||||
|
6 rem stages 1 and 2 merged, plus the device probe
|
||||||
|
7 rem and the header read. complete less cosmetics.
|
||||||
|
8 rem
|
||||||
|
9 rem line map:
|
||||||
|
10 rem 0- 99 header and variable table
|
||||||
|
11 rem 100-199 constants
|
||||||
|
12 rem 200-299 splash
|
||||||
|
13 rem 300-449 bus probe and device select
|
||||||
|
14 rem 450-529 drive identification
|
||||||
|
15 rem 530-609 header read and display
|
||||||
|
16 rem 610-799 name and id entry
|
||||||
|
17 rem 800-899 confirmation screen
|
||||||
|
18 rem 900-1019 execute and status
|
||||||
|
19 rem 1020-1099 result and menu loop
|
||||||
|
20 rem 2000+ subroutines only
|
||||||
|
21 rem
|
||||||
|
22 rem *** this program erases disks. ***
|
||||||
|
23 rem
|
||||||
|
24 rem ***********************************************
|
||||||
|
25 rem variable table
|
||||||
|
26 rem basic 2.0 sees only the first two characters
|
||||||
|
27 rem of a name. do not add names that collide on
|
||||||
|
28 rem two chars or that contain a basic token.
|
||||||
|
29 rem fn, to, on, or, if, st, ti are tokens; none of
|
||||||
|
30 rem the names below contain one.
|
||||||
|
31 rem
|
||||||
|
32 rem --- constants ---
|
||||||
|
33 rem b$ base36 digit table
|
||||||
|
34 rem (the old nw$ and iw$ whitelist
|
||||||
|
35 rem strings are gone - see 4160)
|
||||||
|
36 rem
|
||||||
|
37 rem --- device and drive ---
|
||||||
|
38 rem dv target device number
|
||||||
|
39 rem pd program's own device, peek(186)
|
||||||
|
40 rem np count of devices that answered
|
||||||
|
41 rem pv() device numbers that answered
|
||||||
|
42 rem sd menu index into pv()
|
||||||
|
43 rem dt drive class: 0=unknown 1=1541 2=1581
|
||||||
|
44 rem nt$ drive name for display
|
||||||
|
45 rem vs$ raw dos version reply
|
||||||
|
46 rem tr header track nf name offset
|
||||||
|
47 rem
|
||||||
|
48 rem --- disk state ---
|
||||||
|
49 rem cn$ current disk name, from the header
|
||||||
|
50 rem ci$ current disk id, from the header
|
||||||
|
51 rem hr 1 = header read succeeded
|
||||||
|
52 rem dn$ new disk name, normalized
|
||||||
|
53 rem id$ new two character disk id
|
||||||
|
54 rem h hash accumulator, always < 1296
|
||||||
|
55 rem hi lo high and low base36 digits
|
||||||
|
56 rem
|
||||||
|
57 rem --- dos ---
|
||||||
|
58 rem en dos error number
|
||||||
|
59 rem em$ dos reply text, whole line
|
||||||
|
61 rem
|
||||||
|
62 rem --- input routine, 4000 ---
|
||||||
|
63 rem ml fc df$ in$ ff ky$ a
|
||||||
|
64 rem --- scan routine, 3000 ---
|
||||||
|
65 rem hs$ fs$ fd ln i
|
||||||
|
66 rem --- hash routine, 3600 ---
|
||||||
|
67 rem nm$ i
|
||||||
|
68 rem
|
||||||
|
69 rem k general loop counter
|
||||||
|
70 rem a$ keypress / byte scratch
|
||||||
|
71 rem ***********************************************
|
||||||
|
72 rem
|
||||||
|
100 rem --- constants ---------------------------------
|
||||||
|
101 rem b$ is the base36 digit table, used only by
|
||||||
|
102 rem the encoder at 3800. the old nw$ and iw$
|
||||||
|
103 rem whitelist strings are gone: the input filter
|
||||||
|
104 rem now tests character codes numerically.
|
||||||
|
110 b$="0123456789abcdefghijklmnopqrstuvwxyz"
|
||||||
|
140 dim pv(4)
|
||||||
|
150 pd=peek(186)
|
||||||
|
160 rem
|
||||||
|
200 rem --- splash ------------------------------------
|
||||||
|
210 print chr$(147);
|
||||||
|
220 print "disk formatter"
|
||||||
|
230 print "1541 / 1571 / 1581"
|
||||||
|
240 print
|
||||||
|
250 print "loaded from device";pd
|
||||||
|
260 print
|
||||||
|
270 rem
|
||||||
|
300 rem --- probe the bus -----------------------------
|
||||||
|
310 print "scanning devices 8-11..."
|
||||||
|
320 gosub 2800
|
||||||
|
330 if np=0 then print : print "no drives answered." : end
|
||||||
|
340 print
|
||||||
|
350 print "found:"
|
||||||
|
360 for k=1 to np : print " ";k;" = device";pv(k) : next k
|
||||||
|
370 print
|
||||||
|
380 print "select 1-";np;": ";
|
||||||
|
390 get a$ : if a$="" then 390
|
||||||
|
400 sd=val(a$)
|
||||||
|
410 if sd<1 or sd>np then 390
|
||||||
|
420 dv=pv(sd)
|
||||||
|
430 print dv
|
||||||
|
440 rem
|
||||||
|
450 rem --- identify the drive ------------------------
|
||||||
|
460 print
|
||||||
|
470 print "identifying..."
|
||||||
|
480 gosub 2200
|
||||||
|
490 print "reply : ";vs$
|
||||||
|
500 print "drive : ";nt$
|
||||||
|
510 if dt=0 then print : print "unrecognised drive." : goto 1020
|
||||||
|
520 rem
|
||||||
|
530 rem --- read the current header -------------------
|
||||||
|
531 rem a brand new disk fails this. that is the
|
||||||
|
532 rem normal case for this program, not an error.
|
||||||
|
533 rem write protection is not checked here: it
|
||||||
|
534 rem blocks writes only, so the header read
|
||||||
|
535 rem succeeds and dos reports 26 at format time.
|
||||||
|
540 print
|
||||||
|
550 print "reading disk..."
|
||||||
|
560 gosub 2600
|
||||||
|
570 if hr=1 then print "current: ";cn$;" id ";ci$
|
||||||
|
580 if hr=0 then print "current: unformatted or unreadable"
|
||||||
|
590 rem
|
||||||
|
610 rem --- collect the new name ----------------------
|
||||||
|
620 print
|
||||||
|
630 print "new disk name, 16 max"
|
||||||
|
640 print ">";
|
||||||
|
650 ml=16 : fc=1 : df$="" : gosub 4000
|
||||||
|
660 gosub 3400
|
||||||
|
670 dn$=in$
|
||||||
|
680 if dn$="" then print "name cannot be empty." : goto 640
|
||||||
|
690 rem
|
||||||
|
700 rem --- hash it, then offer the id ----------------
|
||||||
|
701 rem enter accepts the computed value. typing any
|
||||||
|
702 rem valid character clears it and starts fresh.
|
||||||
|
703 rem delete edits it one character at a time.
|
||||||
|
710 nm$=dn$ : gosub 3600
|
||||||
|
720 gosub 3800
|
||||||
|
730 print
|
||||||
|
740 print "disk id, enter accepts the hash"
|
||||||
|
750 print ">";
|
||||||
|
760 ml=2 : fc=2 : df$=id$ : gosub 4000
|
||||||
|
770 if len(in$)<2 then print "id must be 2 characters." : goto 750
|
||||||
|
780 id$=in$
|
||||||
|
790 rem
|
||||||
|
800 rem --- confirmation ------------------------------
|
||||||
|
801 rem everything destructive is behind this screen.
|
||||||
|
805 print chr$(147);
|
||||||
|
810 print "confirm format"
|
||||||
|
815 print
|
||||||
|
820 print "device :";dv;" ";nt$
|
||||||
|
825 if hr=1 then print "erasing: ";cn$;" id ";ci$
|
||||||
|
830 if hr=0 then print "erasing: unformatted disk"
|
||||||
|
835 print
|
||||||
|
840 print "new name: ";dn$
|
||||||
|
845 print "new id : ";id$
|
||||||
|
850 print
|
||||||
|
855 print "command : n0:";dn$;",";id$
|
||||||
|
860 print
|
||||||
|
870 if dv=pd then gosub 3200
|
||||||
|
871 rem -- the confirmation is graded by whether the
|
||||||
|
872 rem disk actually holds anything. a blank disk
|
||||||
|
873 rem costs nothing, so making the user type a
|
||||||
|
874 rem word for it only trains the habit of typing
|
||||||
|
875 rem it without reading.
|
||||||
|
876 if hr=0 then 890
|
||||||
|
879 rem -- disk holds data: require the whole word
|
||||||
|
880 print "all data on this disk will be lost."
|
||||||
|
882 print "type yes to proceed: ";
|
||||||
|
884 ml=3 : fc=3 : df$="" : gosub 4000
|
||||||
|
886 if in$<>"yes" then print : print "cancelled." : goto 1020
|
||||||
|
888 goto 899
|
||||||
|
889 rem
|
||||||
|
890 rem -- blank disk: one keypress is enough
|
||||||
|
891 print "disk is blank. press y to format,"
|
||||||
|
892 print "any other key to cancel: ";
|
||||||
|
894 get a$ : if a$="" then 894
|
||||||
|
895 print a$
|
||||||
|
896 if a$<>"y" then print : print "cancelled." : goto 1020
|
||||||
|
899 rem falls through to execute
|
||||||
|
900 rem --- execute -----------------------------------
|
||||||
|
901 rem the get# inside the error channel reader
|
||||||
|
902 rem blocks until the drive finishes and answers,
|
||||||
|
903 rem so no explicit wait is needed. no progress
|
||||||
|
904 rem display is possible - the bus is busy for the
|
||||||
|
905 rem whole operation.
|
||||||
|
910 print
|
||||||
|
920 print "formatting. do not switch off."
|
||||||
|
940 gosub 2000
|
||||||
|
960 print
|
||||||
|
970 print "status:";en
|
||||||
|
980 print "reply : ";em$
|
||||||
|
1000 print
|
||||||
|
1005 if en=0 then print "format complete."
|
||||||
|
1010 if en<>0 then print "format failed."
|
||||||
|
1019 rem
|
||||||
|
1020 rem --- menu loop ---------------------------------
|
||||||
|
1030 print
|
||||||
|
1040 print "another disk? y/n";
|
||||||
|
1050 get a$ : if a$="" then 1050
|
||||||
|
1060 if a$="y" then 200
|
||||||
|
1070 if a$<>"n" then 1050
|
||||||
|
1080 print : print : print "done."
|
||||||
|
1085 close 2 : close 15
|
||||||
|
1090 end
|
||||||
|
1099 rem
|
||||||
|
2000 rem --- format ------------------------------------
|
||||||
|
2001 rem n0:name,id = full format, writes the id
|
||||||
|
2002 rem n0:name = directory wipe only, keeps id
|
||||||
|
2003 rem only the full form is used.
|
||||||
|
2010 open 15,dv,15
|
||||||
|
2020 print#15,"n0:"+dn$+","+id$
|
||||||
|
2030 gosub 2400
|
||||||
|
2040 close 15
|
||||||
|
2050 return
|
||||||
|
2060 rem
|
||||||
|
2200 rem --- identify drive ----------------------------
|
||||||
|
2201 rem ui is the drive's power-up vector. it is
|
||||||
|
2202 rem nondestructive and makes the drive report
|
||||||
|
2203 rem its dos version on the error channel.
|
||||||
|
2204 rem
|
||||||
|
2205 rem a 1571 on a c64 powers up in 1541 mode, so a
|
||||||
|
2206 rem plain n0: on it produces a valid single
|
||||||
|
2207 rem sided disk. it is recognised and labelled
|
||||||
|
2208 rem rather than rejected. double sided support
|
||||||
|
2209 rem belongs in a c128 version.
|
||||||
|
2210 rem
|
||||||
|
2211 rem jiffydos rewrites the copyright text but
|
||||||
|
2212 rem leaves the model number in place, so the
|
||||||
|
2213 rem substring scan still finds it:
|
||||||
|
2214 rem 73,(c) 1989 jiffydos 6.0 1581,00,00
|
||||||
|
2220 dt=0 : nt$="unknown" : vs$=""
|
||||||
|
2230 open 15,dv,15
|
||||||
|
2240 print#15,"ui"
|
||||||
|
2250 gosub 2400
|
||||||
|
2260 vs$=em$
|
||||||
|
2270 close 15
|
||||||
|
2280 if vs$="" then nt$="no response" : return
|
||||||
|
2290 hs$=vs$
|
||||||
|
2300 fs$="1541" : gosub 3000 : if fd>0 then dt=1 : nt$="1541"
|
||||||
|
2310 fs$="1571" : gosub 3000 : if fd>0 then dt=1 : nt$="1571 in 1541 mode"
|
||||||
|
2320 fs$="1581" : gosub 3000 : if fd>0 then dt=2 : nt$="1581"
|
||||||
|
2330 return
|
||||||
|
2340 rem
|
||||||
|
2400 rem --- read error channel, comma safe ------------
|
||||||
|
2401 rem the usual idiom
|
||||||
|
2402 rem input#15,en,em$,et,es
|
||||||
|
2403 rem mis-splits any reply whose message field
|
||||||
|
2404 rem contains a comma. jiffydos replies do.
|
||||||
|
2405 rem read the whole line as one string and take
|
||||||
|
2406 rem the error number off the front.
|
||||||
|
2407 rem channel 15 must already be open.
|
||||||
|
2408 rem
|
||||||
|
2409 rem codes worth knowing:
|
||||||
|
2410 rem 00 ok 21 read error
|
||||||
|
2411 rem 26 write protect 33 illegal name
|
||||||
|
2412 rem 66 illegal track 72 disk full
|
||||||
|
2413 rem 73 dos version 74 drive not ready
|
||||||
|
2420 em$="" : en=0
|
||||||
|
2430 get#15,a$
|
||||||
|
2440 if a$<>chr$(13) and st=0 then em$=em$+a$ : goto 2430
|
||||||
|
2450 en=val(left$(em$,2))
|
||||||
|
2460 return
|
||||||
|
2470 rem
|
||||||
|
2600 rem --- read the disk header ----------------------
|
||||||
|
2601 rem 1541: track 18 sector 0, name at offset 144
|
||||||
|
2602 rem 1581: track 40 sector 0, name at offset 4
|
||||||
|
2603 rem on both the id sits exactly 18 bytes past
|
||||||
|
2604 rem the name, so only two constants differ.
|
||||||
|
2605 rem
|
||||||
|
2606 rem u1 <channel> <drive> <track> <sector>
|
||||||
|
2607 rem str$ emits a leading space for positive
|
||||||
|
2608 rem numbers, which supplies the separator.
|
||||||
|
2610 cn$="" : ci$="" : hr=0
|
||||||
|
2615 if dt=1 then tr=18 : nf=144
|
||||||
|
2620 if dt=2 then tr=40 : nf=4
|
||||||
|
2625 open 15,dv,15
|
||||||
|
2630 open 2,dv,2,"#"
|
||||||
|
2635 print#15,"u1 2 0"+str$(tr)+" 0"
|
||||||
|
2640 gosub 2400
|
||||||
|
2645 if en<>0 then close 2 : close 15 : return
|
||||||
|
2650 print#15,"b-p 2"+str$(nf)
|
||||||
|
2655 for k=1 to 16 : gosub 2700 : cn$=cn$+a$ : next k
|
||||||
|
2660 print#15,"b-p 2"+str$(nf+18)
|
||||||
|
2665 for k=1 to 2 : gosub 2700 : ci$=ci$+a$ : next k
|
||||||
|
2670 close 2 : close 15
|
||||||
|
2675 hr=1
|
||||||
|
2680 rem names are padded with shifted space, $a0
|
||||||
|
2685 if cn$="" then return
|
||||||
|
2690 if right$(cn$,1)=chr$(160) then cn$=left$(cn$,len(cn$)-1) : goto 2685
|
||||||
|
2695 return
|
||||||
|
2699 rem
|
||||||
|
2700 rem --- get one byte from channel 2 ---------------
|
||||||
|
2701 rem get# returns an empty string for a null
|
||||||
|
2702 rem byte, which would silently shorten the
|
||||||
|
2703 rem result and misalign later offsets.
|
||||||
|
2710 get#2,a$
|
||||||
|
2720 if a$="" then a$=chr$(0)
|
||||||
|
2730 return
|
||||||
|
2740 rem
|
||||||
|
2800 rem --- probe devices 8-11 ------------------------
|
||||||
|
2801 rem neither open/get# nor open/print# works
|
||||||
|
2802 rem here. a get# from an absent device can stall
|
||||||
|
2803 rem on the serial handshake, and a print# makes
|
||||||
|
2804 rem basic raise ?device not present and abort -
|
||||||
|
2805 rem basic 2.0 has no error trapping, so the
|
||||||
|
2806 rem program dies before st can be tested.
|
||||||
|
2807 rem
|
||||||
|
2808 rem so call the kernal directly. sys cannot
|
||||||
|
2809 rem raise a basic error.
|
||||||
|
2810 rem
|
||||||
|
2811 rem listen ALONE is not a valid presence test.
|
||||||
|
2812 rem measured on this setup, devices 4-15:
|
||||||
|
2813 rem listen only 6 8 9 11 13
|
||||||
|
2814 rem listen + delay 5 6 7 8 9 10 12 13 14 15
|
||||||
|
2815 rem listen + second 8 9 <- correct
|
||||||
|
2816 rem listen stops after sending the address,
|
||||||
|
2817 rem before the kernal validates that anything
|
||||||
|
2818 rem answered, so st reflects whatever the data
|
||||||
|
2819 rem line happened to be doing. sending the
|
||||||
|
2820 rem secondary address completes the addressing
|
||||||
|
2821 rem handshake and makes the check meaningful.
|
||||||
|
2822 rem
|
||||||
|
2823 rem 144 ($90) kernal status byte, st
|
||||||
|
2824 rem 780 the a register for sys
|
||||||
|
2825 rem 783 processor status for sys,
|
||||||
|
2826 rem cleared so stale flags -
|
||||||
|
2827 rem decimal mode above all -
|
||||||
|
2828 rem cannot ride into the kernal
|
||||||
|
2829 rem 65457 ($ffb1) listen, device number in a
|
||||||
|
2830 rem 65427 ($ff93) second, secondary address
|
||||||
|
2831 rem 65454 ($ffae) unlisten, releases the bus
|
||||||
|
2832 rem
|
||||||
|
2833 rem 111 = 15 + 96: the command channel secondary
|
||||||
|
2834 rem address, or'd with $60 as listen requires.
|
||||||
|
2835 rem
|
||||||
|
2836 rem st is cleared before listen so a stale 128
|
||||||
|
2837 rem cannot be misread as absence, and cleared
|
||||||
|
2838 rem AGAIN before unlisten: the kernal serial
|
||||||
|
2839 rem routines test bit 7 on entry and abort when
|
||||||
|
2840 rem it is set, so after a failed listen the
|
||||||
|
2841 rem unlisten would be skipped and attention
|
||||||
|
2842 rem would stay asserted, wedging the bus for
|
||||||
|
2843 rem everything afterwards including the next
|
||||||
|
2844 rem load.
|
||||||
|
2845 rem
|
||||||
|
2846 rem the delay is kept because it was present in
|
||||||
|
2847 rem the configuration that measured correctly.
|
||||||
|
2848 rem it costs about a second and a half over four
|
||||||
|
2849 rem devices, which is not worth the risk of
|
||||||
|
2850 rem changing a verified result.
|
||||||
|
2851 rem
|
||||||
|
2852 rem a present drive is left addressed to listen
|
||||||
|
2853 rem on the command channel and then unlistened
|
||||||
|
2854 rem with no data, so it may log error 31. that
|
||||||
|
2855 rem is harmless: identify opens channel 15 and
|
||||||
|
2856 rem sends ui next, which clears it.
|
||||||
|
2857 np=0
|
||||||
|
2858 for k=8 to 11
|
||||||
|
2860 : poke 144,0
|
||||||
|
2862 : poke 780,k : poke 783,0 : sys 65457
|
||||||
|
2864 : poke 780,111 : poke 783,0 : sys 65427
|
||||||
|
2866 : if peek(144)=0 then np=np+1 : pv(np)=k
|
||||||
|
2868 : poke 144,0
|
||||||
|
2870 : sys 65454
|
||||||
|
2872 : for i=1 to 400 : next i
|
||||||
|
2874 next k
|
||||||
|
2890 return
|
||||||
|
2895 rem
|
||||||
|
3000 rem --- substring scan ----------------------------
|
||||||
|
3001 rem basic 2.0 has no instr. finds fs$ inside hs$
|
||||||
|
3002 rem and returns its position in fd, or 0.
|
||||||
|
3003 rem a goto loop rather than for/next, so it can
|
||||||
|
3004 rem return early without stranding a for entry
|
||||||
|
3005 rem on the stack.
|
||||||
|
3010 fd=0 : ln=len(fs$) : i=1
|
||||||
|
3020 if ln=0 or ln>len(hs$) then return
|
||||||
|
3030 if mid$(hs$,i,ln)=fs$ then fd=i : return
|
||||||
|
3040 i=i+1
|
||||||
|
3050 if i<=len(hs$)-ln+1 then 3030
|
||||||
|
3060 return
|
||||||
|
3070 rem
|
||||||
|
3200 rem --- own-disk guard ----------------------------
|
||||||
|
3201 rem peek(186) holds the device of the last i/o,
|
||||||
|
3202 rem which for a freshly loaded program is where
|
||||||
|
3203 rem it came from.
|
||||||
|
3210 print "*** this is the device this program"
|
||||||
|
3220 print "*** was loaded from. formatting it"
|
||||||
|
3230 print "*** will destroy this program."
|
||||||
|
3240 print
|
||||||
|
3250 return
|
||||||
|
3260 rem
|
||||||
|
3400 rem --- normalize: trim spaces from in$ -----------
|
||||||
|
3401 rem without this, "games" and "games " hash to
|
||||||
|
3402 rem different ids and repeatability is a lie.
|
||||||
|
3403 rem no case folding is needed: the whitelist
|
||||||
|
3404 rem only admits petscii 48-57 and 65-90, which
|
||||||
|
3405 rem match ascii, so the python reference agrees
|
||||||
|
3406 rem by construction.
|
||||||
|
3410 if left$(in$,1)=" " then in$=mid$(in$,2) : goto 3410
|
||||||
|
3420 if right$(in$,1)=" " then in$=left$(in$,len(in$)-1) : goto 3420
|
||||||
|
3430 return
|
||||||
|
3440 rem
|
||||||
|
3600 rem --- hash: nm$ in, h out -----------------------
|
||||||
|
3601 rem h = (h * 31 + asc(c)) mod 1296 per character
|
||||||
|
3602 rem
|
||||||
|
3603 rem the mod is applied inside the loop. basic
|
||||||
|
3604 rem 2.0 carries about 9 significant digits, so
|
||||||
|
3605 rem an unreduced accumulator loses precision by
|
||||||
|
3606 rem the sixth character and the hash silently
|
||||||
|
3607 rem degrades. reducing every pass caps the
|
||||||
|
3608 rem largest intermediate at 1295*31+255 = 40400,
|
||||||
|
3609 rem which is exact.
|
||||||
|
3610 rem
|
||||||
|
3611 rem verified equal to diskid.py --vectors
|
||||||
|
3620 h=0
|
||||||
|
3630 for i=1 to len(nm$)
|
||||||
|
3640 : h=h*31+asc(mid$(nm$,i,1))
|
||||||
|
3650 : h=h-int(h/1296)*1296
|
||||||
|
3660 next i
|
||||||
|
3670 return
|
||||||
|
3680 rem
|
||||||
|
3800 rem --- encode: h in, id$ out ---------------------
|
||||||
|
3801 rem two base36 digits, high then low. both land
|
||||||
|
3802 rem in 0-9 a-z, always legal in a sector header.
|
||||||
|
3810 hi=int(h/36)
|
||||||
|
3820 lo=h-hi*36
|
||||||
|
3830 id$=mid$(b$,hi+1,1)+mid$(b$,lo+1,1)
|
||||||
|
3840 return
|
||||||
|
3850 rem
|
||||||
|
4000 rem --- filtered input ----------------------------
|
||||||
|
4001 rem in: ml maximum characters
|
||||||
|
4002 rem fc field code: 1 name, 2 id,
|
||||||
|
4003 rem 3 yes/no - selects the filter
|
||||||
|
4004 rem df$ prefilled default, "" for none
|
||||||
|
4005 rem out: in$ entered string, not trimmed
|
||||||
|
4006 rem
|
||||||
|
4007 rem everything outside the filter is discarded
|
||||||
|
4008 rem silently, so illegal characters never reach
|
||||||
|
4009 rem dos.
|
||||||
|
4010 rem note: run/stop still breaks the program.
|
||||||
|
4011 rem basic checks it between statements and a
|
||||||
|
4012 rem get loop cannot suppress that.
|
||||||
|
4020 in$=df$ : ff=0
|
||||||
|
4030 if df$<>"" then print df$; : ff=1
|
||||||
|
4040 rem
|
||||||
|
4050 rem -- wait for a key, cursor visible
|
||||||
|
4051 rem location 204 is the kernal cursor blink
|
||||||
|
4052 rem enable: 0 = on, 1 = off. if the blink leaves
|
||||||
|
4053 rem reversed characters stranded on your setup,
|
||||||
|
4054 rem delete the two pokes - the routine works
|
||||||
|
4055 rem fine with no cursor.
|
||||||
|
4060 poke 204,0
|
||||||
|
4070 get ky$ : if ky$="" then 4070
|
||||||
|
4080 poke 204,1
|
||||||
|
4085 a=asc(ky$)
|
||||||
|
4090 rem
|
||||||
|
4100 if a=13 then 4300
|
||||||
|
4110 if a=20 then 4200
|
||||||
|
4120 rem
|
||||||
|
4130 rem -- fold shifted letters 193-218 to 65-90
|
||||||
|
4140 if a>192 and a<219 then a=a-128 : ky$=chr$(a)
|
||||||
|
4150 rem
|
||||||
|
4160 rem -- character filter, by field code fc
|
||||||
|
4161 rem fc=1 disk name, fc=2 disk id, fc=3 yes/no
|
||||||
|
4162 rem
|
||||||
|
4163 rem this used to scan a whitelist string with
|
||||||
|
4164 rem the substring routine. every mid$ in that
|
||||||
|
4165 rem scan allocated a temporary string, so one
|
||||||
|
4166 rem keystroke cost up to 43 allocations plus the
|
||||||
|
4167 rem garbage they left behind. that, not basic's
|
||||||
|
4168 rem speed, is what made entry sluggish. numeric
|
||||||
|
4169 rem range tests allocate nothing.
|
||||||
|
4170 rem
|
||||||
|
4171 rem the dos-illegal set , : = * ? is absent from
|
||||||
|
4172 rem every branch, so error 33 stays unreachable.
|
||||||
|
4173 rem ids are base36 only because the id is
|
||||||
|
4174 rem written into every gcr sector header on a
|
||||||
|
4175 rem 1541.
|
||||||
|
4176 if a>47 and a<58 then 4250
|
||||||
|
4177 if a>64 and a<91 then 4250
|
||||||
|
4178 if fc<>1 then 4060
|
||||||
|
4179 if a=32 then 4250
|
||||||
|
4180 if a=45 or a=43 or a=47 or a=46 then 4250
|
||||||
|
4181 if a=40 or a=41 then 4250
|
||||||
|
4182 goto 4060
|
||||||
|
4190 rem
|
||||||
|
4200 rem -- delete
|
||||||
|
4210 if ff=1 then ff=0
|
||||||
|
4220 if in$="" then 4060
|
||||||
|
4230 in$=left$(in$,len(in$)-1) : print chr$(20); : goto 4060
|
||||||
|
4240 rem
|
||||||
|
4250 rem -- accept a character
|
||||||
|
4251 rem the first valid keystroke wipes the whole
|
||||||
|
4252 rem prefilled default, as a selected field does.
|
||||||
|
4260 if ff=1 then gosub 4400
|
||||||
|
4270 if len(in$)>=ml then 4060
|
||||||
|
4280 in$=in$+ky$ : print ky$; : goto 4060
|
||||||
|
4290 rem
|
||||||
|
4300 rem -- enter pressed, finish
|
||||||
|
4301 rem the trailing space overwrites any reversed
|
||||||
|
4302 rem cell the cursor may have left behind.
|
||||||
|
4310 poke 204,1 : poke 207,0
|
||||||
|
4320 print " "
|
||||||
|
4330 return
|
||||||
|
4340 rem
|
||||||
|
4400 rem -- wipe the prefilled default
|
||||||
|
4410 ff=0
|
||||||
|
4420 for i=1 to len(in$) : print chr$(20); : next i
|
||||||
|
4430 in$=""
|
||||||
|
4440 return
|
||||||
100
src/iecprobe.bas
Normal file
100
src/iecprobe.bas
Normal file
|
|
@ -0,0 +1,100 @@
|
||||||
|
0 rem ***********************************************
|
||||||
|
1 rem iecprobe.bas - serial bus presence diagnostic
|
||||||
|
2 rem ***********************************************
|
||||||
|
3 rem
|
||||||
|
4 rem purpose: find out whether kernal listen is a
|
||||||
|
5 rem trustworthy presence test on this setup.
|
||||||
|
6 rem
|
||||||
|
7 rem why it might not be: when the c64 asserts
|
||||||
|
8 rem attention, every device on the bus pulls data
|
||||||
|
9 rem low, not just the one being addressed. the
|
||||||
|
10 rem others release it once the address byte shows
|
||||||
|
11 rem it is not for them. the kernal decides a
|
||||||
|
12 rem device is present by checking whether data is
|
||||||
|
13 rem still held after that byte - so the test is a
|
||||||
|
14 rem race against how fast the other drives let go.
|
||||||
|
15 rem
|
||||||
|
16 rem a false present immediately after a real
|
||||||
|
17 rem device is the signature of losing that race.
|
||||||
|
18 rem
|
||||||
|
19 rem three passes:
|
||||||
|
20 rem 1 listen only, back to back
|
||||||
|
21 rem 2 listen only, settle delay between probes
|
||||||
|
22 rem 3 listen plus secondary address, delayed
|
||||||
|
23 rem
|
||||||
|
24 rem pass 3 completes the full addressing handshake
|
||||||
|
25 rem rather than stopping halfway, which gives the
|
||||||
|
26 rem kernal a second timeout check to fail on.
|
||||||
|
27 rem
|
||||||
|
28 rem reading the result:
|
||||||
|
29 rem all three agree on 8 and 9 -> reliable
|
||||||
|
30 rem pass 1 wrong, 2 or 3 right -> use that one
|
||||||
|
31 rem all list most of 4-15 -> listen is
|
||||||
|
32 rem not a valid
|
||||||
|
33 rem test here
|
||||||
|
34 rem
|
||||||
|
35 rem range is 4-15, not 8-11, on purpose: if
|
||||||
|
36 rem printer and unused numbers also report
|
||||||
|
37 rem present, the method is broken rather than the
|
||||||
|
38 rem bus being slow.
|
||||||
|
39 rem
|
||||||
|
40 rem run this with vice true drive emulation both
|
||||||
|
41 rem on and off. with it off, vice services disk
|
||||||
|
42 rem access through kernal traps and the handshake
|
||||||
|
43 rem this depends on may not be emulated at all.
|
||||||
|
44 rem
|
||||||
|
45 rem kernal calls used:
|
||||||
|
46 rem 65457 ($ffb1) listen, device number in a
|
||||||
|
47 rem 65427 ($ff93) second, secondary address in a
|
||||||
|
48 rem 65454 ($ffae) unlisten, releases the bus
|
||||||
|
49 rem 144 ($90) status byte, 128 = not present
|
||||||
|
50 rem 780 a register for sys
|
||||||
|
51 rem 783 processor status for sys,
|
||||||
|
52 rem cleared so stale flags cannot
|
||||||
|
53 rem ride into the kernal
|
||||||
|
54 rem
|
||||||
|
55 rem 111 = 15 + 96: command channel secondary
|
||||||
|
56 rem address, or'd with $60 as listen requires.
|
||||||
|
57 rem ***********************************************
|
||||||
|
58 rem
|
||||||
|
100 print chr$(147);
|
||||||
|
110 print "iec presence probe"
|
||||||
|
120 print
|
||||||
|
130 md=0 : dl=0
|
||||||
|
140 print "1 listen only:"
|
||||||
|
150 gosub 1000
|
||||||
|
160 print
|
||||||
|
170 md=0 : dl=1
|
||||||
|
180 print "2 listen + delay:"
|
||||||
|
190 gosub 1000
|
||||||
|
200 print
|
||||||
|
210 md=1 : dl=1
|
||||||
|
220 print "3 listen + second + delay:"
|
||||||
|
230 gosub 1000
|
||||||
|
240 print
|
||||||
|
250 print "listed = status 0 after the call."
|
||||||
|
260 end
|
||||||
|
270 rem
|
||||||
|
1000 rem --- probe 4 to 15 -----------------------------
|
||||||
|
1001 rem st is cleared before unlisten as well as
|
||||||
|
1002 rem before listen. the kernal serial routines
|
||||||
|
1003 rem test bit 7 of st on entry and abort when it
|
||||||
|
1004 rem is set, so after a failed listen the
|
||||||
|
1005 rem unlisten is skipped, attention stays
|
||||||
|
1006 rem asserted, and the bus is wedged for
|
||||||
|
1007 rem everything afterwards - including the next
|
||||||
|
1008 rem load. with most of 4-15 absent this happens
|
||||||
|
1009 rem on nearly every pass.
|
||||||
|
1010 print " present:";
|
||||||
|
1020 for k=4 to 15
|
||||||
|
1030 : poke 144,0
|
||||||
|
1040 : poke 780,k : poke 783,0 : sys 65457
|
||||||
|
1050 : if md=1 then poke 780,111 : poke 783,0 : sys 65427
|
||||||
|
1060 : s1=peek(144)
|
||||||
|
1065 : poke 144,0
|
||||||
|
1070 : sys 65454
|
||||||
|
1080 : if dl=1 then for i=1 to 400 : next i
|
||||||
|
1090 : if s1=0 then print k;
|
||||||
|
1100 next k
|
||||||
|
1110 print
|
||||||
|
1120 return
|
||||||
158
src/memprobe.bas
Normal file
158
src/memprobe.bas
Normal file
|
|
@ -0,0 +1,158 @@
|
||||||
|
0 rem ***********************************************
|
||||||
|
1 rem memprobe.bas - ram survival probe
|
||||||
|
2 rem target: c64 / basic 2.0
|
||||||
|
3 rem ***********************************************
|
||||||
|
4 rem
|
||||||
|
5 rem purpose:
|
||||||
|
6 rem fill candidate machine-code areas with a known
|
||||||
|
7 rem pattern, then - after exercising the machine -
|
||||||
|
8 rem verify whether the pattern survived.
|
||||||
|
9 rem
|
||||||
|
10 rem usage:
|
||||||
|
11 rem 1. save this program to disk as "memprobe"
|
||||||
|
12 rem 2. load, run, choose 1 (fill), then exit
|
||||||
|
13 rem 3. exercise the machine however you normally
|
||||||
|
14 rem use it: load programs, read directories,
|
||||||
|
15 rem format a disk, enter and leave the ultimate
|
||||||
|
16 rem menu, trip the freezer, etc.
|
||||||
|
17 rem 4. load and run again, choose 2 (check)
|
||||||
|
18 rem
|
||||||
|
19 rem note: reloading this program is itself part of
|
||||||
|
20 rem the test. the loader - jiffydos or otherwise -
|
||||||
|
21 rem is one of the things we are trying to catch.
|
||||||
|
22 rem
|
||||||
|
23 rem warning: option 1 overwrites $c000-$cfff. if a
|
||||||
|
24 rem dos wedge is installed there it will be
|
||||||
|
25 rem destroyed and will crash on next use. reset
|
||||||
|
26 rem the machine before reinstalling one.
|
||||||
|
27 rem
|
||||||
|
28 rem ***********************************************
|
||||||
|
29 rem variable table
|
||||||
|
30 rem basic 2.0 sees only the first two characters
|
||||||
|
31 rem of a name. do not add names that collide on
|
||||||
|
32 rem two chars or that contain a basic token.
|
||||||
|
33 rem
|
||||||
|
34 rem nr number of candidate ranges
|
||||||
|
35 rem rs() range start address
|
||||||
|
36 rem rl() range length in bytes
|
||||||
|
37 rem rn$() range description for display
|
||||||
|
38 rem k range index j byte offset in range
|
||||||
|
39 rem i digit index, hex routine only
|
||||||
|
40 rem mm mismatch count for current range
|
||||||
|
41 rem f1 first mismatching address, -1 = none
|
||||||
|
42 rem l1 last mismatching address, -1 = none
|
||||||
|
43 rem se menu selection
|
||||||
|
44 rem v value in, hex routine
|
||||||
|
45 rem hi working digit, hex routine
|
||||||
|
46 rem h$ hex string out, hex routine
|
||||||
|
47 rem a$ keypress / byte scratch
|
||||||
|
48 rem en dos error number em$ dos error text
|
||||||
|
49 rem ***********************************************
|
||||||
|
50 rem
|
||||||
|
100 rem --- candidate range table ---------------------
|
||||||
|
101 rem pattern written is (offset and 255), so a
|
||||||
|
102 rem block move or a zero fill both show up.
|
||||||
|
110 nr=3
|
||||||
|
120 dim rs(nr),rl(nr),rn$(nr)
|
||||||
|
130 for k=1 to nr : read rs(k),rl(k),rn$(k) : next k
|
||||||
|
140 data 679,89,"$02a7-$02ff spare bytes"
|
||||||
|
150 data 828,192,"$033c-$03fb tape buffer"
|
||||||
|
160 data 49152,4096,"$c000-$cfff free ram"
|
||||||
|
170 rem
|
||||||
|
200 rem --- main menu ---------------------------------
|
||||||
|
210 print chr$(147);
|
||||||
|
220 print "ram survival probe"
|
||||||
|
230 print
|
||||||
|
240 print " 1 = fill candidate areas"
|
||||||
|
250 print " 2 = check candidate areas"
|
||||||
|
260 print " 3 = exercise disk i/o now"
|
||||||
|
270 print " 4 = exit"
|
||||||
|
280 print
|
||||||
|
290 print "choice: ";
|
||||||
|
300 get a$ : if a$="" then 300
|
||||||
|
310 se=val(a$)
|
||||||
|
320 if se=1 then gosub 1000 : goto 210
|
||||||
|
330 if se=2 then gosub 2000 : goto 210
|
||||||
|
340 if se=3 then gosub 3000 : goto 210
|
||||||
|
350 if se=4 then print : print "done." : end
|
||||||
|
360 goto 300
|
||||||
|
370 rem
|
||||||
|
1000 rem --- fill --------------------------------------
|
||||||
|
1010 print : print "filling. this takes a few seconds."
|
||||||
|
1020 print
|
||||||
|
1030 for k=1 to nr
|
||||||
|
1040 : print rn$(k)
|
||||||
|
1050 : for j=0 to rl(k)-1
|
||||||
|
1060 : poke rs(k)+j, j and 255
|
||||||
|
1070 : next j
|
||||||
|
1080 next k
|
||||||
|
1090 print
|
||||||
|
1100 print "fill complete. exit, exercise the"
|
||||||
|
1110 print "machine, then run again and check."
|
||||||
|
1120 gosub 4000
|
||||||
|
1130 return
|
||||||
|
1140 rem
|
||||||
|
2000 rem --- check -------------------------------------
|
||||||
|
2010 print : print "checking. this takes a few seconds."
|
||||||
|
2020 print
|
||||||
|
2030 for k=1 to nr
|
||||||
|
2040 : mm=0 : f1=-1 : l1=-1
|
||||||
|
2050 : for j=0 to rl(k)-1
|
||||||
|
2060 : if peek(rs(k)+j)=(j and 255) then 2100
|
||||||
|
2070 : mm=mm+1
|
||||||
|
2080 : if f1=-1 then f1=rs(k)+j
|
||||||
|
2090 : l1=rs(k)+j
|
||||||
|
2100 : next j
|
||||||
|
2110 : print rn$(k)
|
||||||
|
2120 : if mm=0 then print " intact" : goto 2170
|
||||||
|
2130 : print " changed bytes:";mm
|
||||||
|
2140 : v=f1 : gosub 5000
|
||||||
|
2150 : print " first:";f1;" ($";h$;")"
|
||||||
|
2160 : v=l1 : gosub 5000 : print " last :";l1;" ($";h$;")"
|
||||||
|
2170 next k
|
||||||
|
2180 gosub 4000
|
||||||
|
2190 return
|
||||||
|
2200 rem
|
||||||
|
3000 rem --- exercise disk i/o on device 8 -------------
|
||||||
|
3001 rem covers the ordinary command-channel and
|
||||||
|
3002 rem directory paths. it does not cover load,
|
||||||
|
3003 rem which is why the fill/check split exists.
|
||||||
|
3010 print : print "exercising disk i/o, device 8."
|
||||||
|
3020 open 15,8,15
|
||||||
|
3030 print#15,"i0"
|
||||||
|
3040 gosub 3500
|
||||||
|
3050 print "status:";en;em$
|
||||||
|
3060 close 15
|
||||||
|
3070 print "reading directory."
|
||||||
|
3080 open 1,8,0,"$"
|
||||||
|
3090 get#1,a$ : if st=0 then 3090
|
||||||
|
3100 close 1
|
||||||
|
3110 print "done."
|
||||||
|
3120 gosub 4000
|
||||||
|
3130 return
|
||||||
|
3140 rem
|
||||||
|
3500 rem --- read error channel, comma safe ------------
|
||||||
|
3501 rem input#15,en,em$,et,es is the usual idiom but
|
||||||
|
3502 rem it mis-splits any reply whose message field
|
||||||
|
3503 rem contains a comma - which jiffydos replies do
|
||||||
|
3504 rem ("73,jiffydos 6.01 1541,00,00"). read the
|
||||||
|
3505 rem whole line as one string instead.
|
||||||
|
3506 rem channel 15 must already be open.
|
||||||
|
3510 em$="" : en=0
|
||||||
|
3520 get#15,a$
|
||||||
|
3530 if a$<>chr$(13) and st=0 then em$=em$+a$ : goto 3520
|
||||||
|
3540 en=val(left$(em$,2))
|
||||||
|
3550 return
|
||||||
|
3560 rem
|
||||||
|
4000 rem --- wait for keypress -------------------------
|
||||||
|
4010 print : print "press any key.";
|
||||||
|
4020 get a$ : if a$="" then 4020
|
||||||
|
4030 return
|
||||||
|
4040 rem
|
||||||
|
5000 rem --- hex: v in, h$ out, four digits ------------
|
||||||
|
5010 h$=""
|
||||||
|
5020 for i=3 to 0 step -1
|
||||||
|
5030 : hi=int(v/(16^i))
|
||||||
|
5040 : h$=h$+mid$("0123456789abcdef",hi-int(hi/16)*16+1,1)
|
||||||
|
5050 next i
|
||||||
|
5060 return
|
||||||
Loading…
Reference in a new issue