program setpara; {$a+,b-,c-,i-,r-,u-,v-,w0,x+} (* Ein Diskettenformat auswaehlen und ins BankCPM installieren (c) 17-Feb-89 Helmut Tischer, Moosburg a.d. Isar Im Programm kommt kein einziger Runtime-Aufruf vor. Deshalb kann man (mu~ aber nicht) folgenden Trick anwenden: - Compilieren des Programmes als CHN-File - Bei Compiler-Options die Anfangsadresse $00E6 (!) w{hlen - Ende-Adresse: Maximal $D900 - die erzeugte Datei mit "DDT SETPARA.CHN" in den Debugger laden - mit "m011A,(Programmende),0100" Vorspann entfernen - Debugger verlassen - Programm mit "SAVE (Programml{nge) SETPARA.COM" abspeichern das Ergebnis ist ein lauff{higes Programm, das um 8KB k}rzer ist als gew|hnliche TurboPascal-Programme !!! *) const CpuStackSize = 128; var CompilerSpeicherEnde: record end; const max = 15; (* Anzahl der bekannten Diskettenformate Minus 1*) xmax = 5; (* Anzahl der verschiedenen XLT-Tabellen Minus 1*) const version: string[12] = 'SETPARA V3.0'; (* Der XDPB hat folgenden Aufbau: Byte 0: Nummer des ersten Sektors einer Spur Byte 1: Sektoren pro Spur und Seite Byte 2: Gap beim lesen und schreiben Byte 3: Gap beim formatieren Byte 4: F}llbyte zum formatieren Byte 5: Sektorgr|~en-Code (3->1024 Bytes, 2->512 Bytes, 1->256 Bytes) Byte 6: Anzahl der Records pro Sektor Byte 7: Nummer der verwendeten XLT-Tabelle (FF-> kein XLT) Byte 8: h|chste Zylindernummer = Spuren pro Seite Minus 1 Byte 9: Flagbyte Bit0=1->Doppelseitig, Bit1=1->40-spuriges Format Einschraenkungen: -max. 128 Checked Directory-Entries (auch wenn mehr Eintraege moeglich) -besondere Massnahmen bei 1024 Byte langen Sektoren -besondere Massnahmen bei XLT-Verwendung GAP-Laengen: Seclen Seczahl Toleranz GAP-Form GAP-RW 256 16 3.9 % 49 23 256 17 2.6 % 32 15 256 18 1.4 % 16 8 512 8 6.0 % 145 68 512 9 3.5 % 81 39 512 10 1.3 % 29 14 1024 4 5.5 % 255 121 1024 5 2.4 % 106 52 *) parameter: array[0..max] of record name: string[38]; dpb: array[0..14] of byte; xdpb: array[0..9] of byte end = ( ( name: 'Vortex System CPC ATARI720 (09D80)'; dpb : ($24,$00,$05,$1f,$03,$b0,$00,$7f,$00,$80,$00,$20,$00,$02,$00); xdpb: ($01,$09,$2a,$52,$e5,$02,$04,$FF,$4f,$01) ),( name: 'Amstrad System Joyce MSDOS180 (09S40)'; dpb : ($24,$00,$03,$07,$00,$ae,$00,$3f,$00,$c0,$00,$10,$00,$01,$00); xdpb: ($01,$09,$2a,$52,$e5,$02,$04,$FF,$27,$02) ),( name: 'Amstrad Data-Only CPC (09S40)'; dpb : ($24,$00,$03,$07,$00,$b3,$00,$3f,$00,$c0,$00,$10,$00,$00,$00); xdpb: ($c1,$09,$2a,$52,$e5,$02,$04,$FF,$27,$02) ),( name: 'Amstrad IBM-SS/8 CPC MSDOS160 (08S40)'; dpb : ($20,$00,$03,$07,$00,$9b,$00,$3f,$00,$c0,$00,$10,$00,$00,$00); xdpb: ($01,$08,$2a,$50,$e5,$02,$04,$FF,$27,$02) ),( name: 'Amstrad System CPC (09S40)'; dpb : ($24,$00,$03,$07,$00,$aa,$00,$3f,$00,$c0,$00,$10,$00,$02,$00); xdpb: ($41,$09,$2a,$52,$e5,$02,$04,$FF,$27,$02) ),( name: 'BD360K System CPC (09S80)'; dpb : ($24,$00,$04,$0f,$01,$ae,$00,$3f,$00,$80,$00,$10,$00,$02,$00); xdpb: ($41,$09,$2a,$52,$e5,$02,$04,$FF,$4f,$00) ),( name: 'Kaypro II (10S40)'; dpb : ($28,$00,$03,$07,$00,$c2,$00,$3f,$00,$c0,$00,$10,$00,$01,$00); xdpb: ($00,$0a,$0e,$1d,$e5,$02,$04,$FF,$27,$02) ),( name: 'Siemens PC16-10 MSDOS360 (09D40)'; dpb : ($24,$00,$04,$0f,$00,$AE,$00,$7F,$00,$C0,$00,$20,$00,$02,$00); xdpb: ($01,$09,$2A,$52,$E5,$02,$04,$FF,$27,$03) ),( name: 'Siemens PC16-11 MSDOS720 (09D80)'; dpb : ($24,$00,$04,$0f,$00,$55,$01,$ff,$00,$f0,$00,$20,$00,$04,$00); xdpb: ($01,$09,$2a,$52,$e5,$02,$04,$FF,$4f,$01) ),( name: 'X-Data 215K (10S43)'; dpb : ($28,$00,$03,$07,$00,$d6,$00,$3f,$00,$c0,$00,$10,$00,$00,$00); xdpb: ($01,$0a,$0e,$1d,$e5,$02,$04,$FF,$2a,$02) ),( name: 'X-Data 820K (10D82)'; dpb : ($28,$00,$04,$0f,$00,$99,$01,$bf,$00,$e0,$00,$20,$00,$00,$00); xdpb: ($01,$0a,$0e,$1d,$e5,$02,$04,$FF,$51,$01) ),( name: 'Siemens PMS-E342 ATARI360 (09S80)'; dpb : ($24,$00,$04,$0f,$00,$AB,$00,$7f,$00,$C0,$00,$20,$00,$03,$00); xdpb: ($01,$09,$2a,$52,$e5,$02,$04,$FF,$4f,$00) ),( name: 'DEC Rainbow (SKEW 2) (10S80)'; dpb : ($28,$00,$04,$0f,$01,$C1,$00,$7f,$00,$C0,$00,$20,$00,$02,$00); xdpb: ($01,$0A,$0E,$1D,$e5,$02,$04,$00,$4f,$00) ),( name: 'Demo->1KB Sektoren mit Skew 3 (05D80)'; dpb : ($28,$00,$04,$0f,$00,$8A,$01,$40,$01,$f8,$00,$20,$00,$02,$00); xdpb: ($01,$05,$34,$6A,$e5,$03,$08,$01,$4f,$01) ),( name: 'Demo->1KB Secs mit Doublesteps (05D40)'; dpb : ($28,$00,$04,$0f,$01,$C7,$00,$7F,$00,$C0,$00,$20,$00,$00,$00); xdpb: ($01,$05,$34,$6A,$e5,$03,$08,$FF,$27,$03) ),( name: '(nicht benutzt) '; dpb : ($00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00); xdpb: ($00,$00,$00,$00,$00,$00,$00,$00,$00,$00) ) ); translate: array[0..xmax] of array[0..39] of Byte = ( (00,01,02,03,20,21,22,23,04,05,06,07,24,25,26,27,08,09,10,11, 28,29,30,31,12,13,14,15,32,33,34,35,16,17,18,19,36,37,38,39 ),( 00,01,02,03,04,05,06,07,16,17,18,19,20,21,22,23,32,33,34,35, 36,37,38,39,08,09,10,11,12,13,14,15,24,25,26,27,28,29,30,31 ),( 00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00, 00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00 ),( 00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00, 00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00 ),( 00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00, 00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00 ),( 00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00, 00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00 ) ); resident: array[0..127] of byte= ($00,$00,$00,$00,$00,$00,$C3,$06,$E6,$C3,$42,$D9,$C3,$12,$D9,$C3, $1F,$D9,$2A,$AC,$D9,$22,$FE,$FB,$2A,$AE,$D9,$22,$04,$F4,$E9,$21, $00,$E6,$11,$00,$D9,$01,$06,$00,$ED,$B0,$2A,$04,$F4,$22,$AE,$D9, $2A,$FE,$FB,$22,$AC,$D9,$21,$09,$D9,$22,$04,$F4,$21,$00,$DA,$22, $FE,$FB,$31,$AC,$D9,$21,$09,$D9,$22,$31,$00,$21,$06,$D9,$22,$06, $00,$21,$03,$F4,$22,$01,$00,$3E,$C3,$32,$00,$00,$32,$05,$00,$32, $30,$00,$0E,$0D,$CD,$06,$E6,$21,$04,$00,$7E,$E6,$0F,$FE,$03,$38, $02,$36,$02,$4E,$C3,$03,$DE,$00,$00,$00,$00,$00,$00,$00,$00,$00); const abbruch : string[29] = '^C'#13#10'***** Abgebrochen *****'#13#10; versionstr: string[41] = ' Diskettenformate waehlen fuer BankCPM'#13#10#10; nocommand : string[32] = 'Kommandozeilenparameter fehlt.'#13#10; nlstr : string[ 2] = #13#10; klammerauf: string[ 3] = ' ('; klammerzu : string[ 2] = ') '; auswahlstr: string[27] = 'welches Format setzen? (A..'; drivestr : string[35] = 'welches Laufwerk einstellen? (A/B) '; format1 : string[20] = 'Format auf Laufwerk '; format2 : string[ 2] = ': '; unmoeglich: string[30] = 'kann nicht eingestellt werden.'; (* Ersatz f}r sonst verwendete Runtime-Routinen *) function getupcasechr: char; (* entspricht read(c);upcase(c) *) begin inline($1E/$FF/$0E/$06/$CD/$05/$00/$A7/$28/$F6/ $FE/$61/$D8/$FE/$7B/$D0/$D6/$20/$6F/$C9) end; procedure displaystr(var s); (* write(s) mit Zeichenkette s *) begin inline($46/$78/$A7/$C8/ $23/$5E/$C5/$E5/$0E/$06/$CD/$05/$00/$E1/$C1/$10/$F3) end; procedure displaychr(c: char); (* write(c) mit Zeichen c *) begin inline($5F/$0E/$06/$CD/$05/$00)end; function eq(a: integer; b: byte): boolean; (* a = b *) begin inline($BD/$21/$01/$00/$C8/$2D/$C9) end; function ne(a: integer; b: byte): boolean; (* a <> b *) begin inline($BD/$21/$01/$00/$C0/$2D/$C9) end; function ge(a: integer; b: byte): boolean; (* a >= b *) begin inline($BD/$21/$01/$00/$D8/$C8/$2D/$C9) end; function le(a: integer; b: byte): boolean; (* a <= b *) begin inline($BD/$21/$01/$00/$D0/$2D/$C9) end; function ishl(a: integer; b: byte): integer; (* a shl b *) begin inline($A7/$C8/$47/$29/$10/$FD/$C9) end; procedure copybytes(var s,z; l: integer); (* move(s,z,l) *) begin inline($ED/$5B/Z/$ED/$4B/L/$ED/$B0) end; procedure installformat(drive, wahl: integer); type xdpb = record spt: integer; bsh,blm,exm: byte; dsm,drm: integer; al0,al1: byte; cks,off: integer; fsc,sec,grw,gfo,fil,siz,rec,cur,trk,flg: byte end; xdpbPtr = ^xdpb; xdph = record xlt: integer; scratch: array[0..2] of integer; dirbuf: integer; dpb: xdpbptr; csv, alv: integer end; xdphptr = ^xdph; var dphfeld: array[0..1] of xdphptr; dphptr: xdphptr; dpbptr: xdpbptr; vorher, nachher: boolean; flag, xtab: integer; hptr, hptr2: ^byte; begin displaystr(format1); displaychr(chr(ord('A')+drive)); displaystr(format2); dphfeld[0] := ptr($FC00); dphfeld[1] := ptr($FC10); vorher := le(mem[$FBFE] + ishl(mem[$FBFF],8),$F400); dphptr := dphfeld[drive]; dpbptr := dphptr^.dpb; if (eq(dpbptr^.flg and 4,0) and eq(parameter[wahl].xdpb[9] and 1,1)) or (eq(dpbptr^.flg and 8,0) and eq(parameter[wahl].xdpb[9] and 2,0)) then displaystr(unmoeglich) else begin displaystr(parameter[wahl].name); flag := (dpbptr^.flg and $FC) or (parameter[wahl].xdpb[9] and 1); if eq(flag and 8,8) and eq(parameter[wahl].xdpb[9] and 2,2) then flag := flag or $02; copybytes(parameter[wahl].dpb,dpbptr^,24); dpbptr^.flg := flag; dpbptr^.cur := dpbptr^.trk; if ne(parameter[wahl].xdpb[7],255) then begin if eq(drive,0) then xtab := $D9B0 else xtab := $D9D8; dphptr^.xlt := xtab; hptr := ptr(xtab); copybytes(translate[parameter[wahl].xdpb[7]],hptr^,40) end else dphptr^.xlt := 0 end; nachher := ne(dphfeld[0]^.xlt,0) or eq(dphfeld[0]^.dpb^.siz,3) or ne(dphfeld[1]^.xlt,0) or eq(dphfeld[1]^.dpb^.siz,3); if vorher and not nachher then begin mem[1] := $0C; mem[2] := $D9 end; if not vorher and nachher then begin hptr := ptr($D900); copybytes(resident,hptr^,128); hptr := ptr($D980); mem[$D980] := 0; hptr2 := ptr($D981); copybytes(hptr^,hptr2^,$47F); mem[1] := $0F; mem[2] := $D9 end; displaystr(nlstr) end; procedure hauptprogramm; var i, format, drive, lines: integer; wahl: char; begin lines :=0; displaystr(version); displaystr(versionstr); if eq(mem[$5C],0) or eq(mem[$5D],ord(' ')) then begin lines :=1; displaystr(nocommand) end; if eq(mem[$5C],1) or eq(mem[$5C],2) then drive := mem[$5c]-1 else begin lines := 1; displaystr(drivestr); repeat wahl := getupcasechr until eq(ord(wahl),ord('A')) or eq(ord(wahl),ord('B')) or eq(ord(wahl),ord(^C)); if eq(ord(wahl),ord(^C)) then begin displaystr(abbruch); exit end; displaychr(wahl); displaystr(nlstr); drive := ord(wahl) - ord('A') end; if le(mem[$5d],pred(ord('A'))) or ge(mem[$5D],ord('A')+succ(max)) then begin lines := 1; i := 0; while le(i,max) do begin displaystr(klammerauf); displaychr(chr(i+ord('a'))); displaystr(klammerzu); displaystr(parameter[i].name); displaystr(nlstr); i := succ(i) end; displaystr(auswahlstr); displaychr(chr(ord('A')+max)); displaystr(klammerzu); repeat wahl := getupcasechr; until ge(ord(wahl),ord('A')) and le(ord(wahl),ord('A') + max) or eq(ord(wahl),ord(^C)); if eq(ord(wahl),ord(^C)) then begin displaystr(abbruch); exit end; displaychr(wahl); displaystr(nlstr); format := ord(wahl)-ord('A') end else format := mem[$5D] - ord('A'); if eq(lines,1) then displaystr(nlstr); installformat(drive, format) end; begin inline($31/CompilerSpeicherEnde+CpuStackSize/ $CD/hauptprogramm/ $C3/$00/$00) end.