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