Listing of SPACE.PAS
1: 0 FUNCTION Freier_Diskettenplatz(Laufwerk:byte):integer;
2: 0 (* fuer CP/M + bzw. CP/M 3.0 und hoeher *)
3: 0 TYPE DMA_Puffer=RECORD
4: 1 Anzahl_der_Records_low:integer;
5: 1 Anzahl_der_Records_high:byte;
6: 1 Fueller:ARRAY[0..124] OF byte;
7: 1 END;
8: 0 VAR p:^DMA_Puffer;
9: 0 BEGIN
10: 1 new(p);
11: 1 bdos(26,ord(p));
12: 1 IF Laufwerk=O THEN Laufwerk:=bdos(25)+1;
13: 1 bdos(46,Laufwerk-1);
14: 1 Freier_Diskettenplatz:=p^.Anzahl_der_Records_low SHR 3
15: 1 +p^.Anzahl_der_Records_high SHL 13;
16: 1 dispose(p);
17: 1 END;
18: 0
19: 0 BEGIN
20: 1 write(Freier_Diskettenplatz(0));
21: 1 END.
8251 (z.B. TA-PC)
function ZeichenVorhanden:boolean;
begin
ZeichenVorhanden:=BIT(1,PORT[$41])
end;
funktion DarfSenden:boolean;
begin
DarfSenden:=BIT(0,PORT[$41])
end;
Z80-SIO (z.B. BONDWELL 14)
function ZeichenVorhanden:boolean;
begin
ZeichenVorhanden:=BIT(2,PORT[$41])
end;
function DarfSenden:boolean;
begin
DarfSenden:=BIT(0,PORT[$41])
end;
function ZeichenVorhanden:boolean;
begin
ZeichenVorhanden:=MEM[xyz]>0
end;
Listing of RS232.INC
1: 0 (****************************************************************************)
2: 0 (* Schnittstellen-Status *)
3: 0 (****************************************************************************)
4: 0
5: 0 FUNCTION BIT(Stelle,Zahl:byte):boolean;
6: 0 BEGIN
7: 1 BIT:=(Zahl AND (1 SHL Stelle))>0
8: 1 END;
9: 0
10: 0 FUNCTION ZeichenVorhanden : boolean; (*Computerabhaengig*)
11: 0 BEGIN
12: 1 ZeichenVorhanden:=(muss erst impementiert werden)
13: 1 END;
14: 0
15: 0 FUNCTION DarfSenden : boolean; (*Computerabhaengig*)
16: 0 BEGIN
17: 1 DarfSenden:=(muss erst implementiert werden)
18: 1 END;
Listing of MINIMOD.PAS
1: 0 (****************************************************************************)
2: 0 (* MINIMOD - einfache Datenfernuebertragung *)
3: 0 (****************************************************************************)
4. 0
5: 0 PROGRAM minimod;
6: 0
7: 0 CONST (*Initialier te Variable*)
8: 0 autolinefeed : boolean = true;
9: 0 echo : boolean = false;
10: 0 printer : boolean = false;
11: 0
12: 0 CONST (*kann bei Bedarf vergroesert werden*)
13: 0 UpLoadKap = 10000;
14: 0
15: 0 VAR ein, aus, c : char;
16: 0
17: 0 TYPE Pufferinhalt = char;
18: 0
19: 0 ($1 PUFFER.BIB)
20: 0 ($1 RS232.INC)
21: 0
22: 0 PROCEDURE Optionen; (*Gibt Options-Menue aus*)
23: 0 BEGIN
24: 1 lowvideo;
25: 1 writeln;
26: 1 writeln('^E = Echo umschalten');
27: 1 writeln('^A = AutoLF umschalten');
28: 1 writeln('^L = Drucker umschalten');
29: 1 writeln('^D = Download (File senden)');
30: 1 writeln('^U = Upload (File empfangen)');
31: 1 writeln('^S = Statusanzeige');
32: 1 IF NOT PufferLeer THEN writeln('^R = Pufferloeschen');
33: 1 writeln('^Z = Programmende');
34: 1 writelnCAP = ^12 senden');
35: 1 normvideo
36: 1 END;
37: 0
38: 0 PROCEDURE SchreibStatus; (*Gibt den Zustand der Flags aus*)
39: 0 CONST Status : ARRAY [boolean] OF STRING[3] = ('aus','ein');
40: 0 BEGIN
41: 1 writeln;
42: 1 writeln('Echo : ',Status[echo]);
43: 1 writeln('CRLF : ',Status[autolinefeed]);
44: 1 writeln('LST : ',Status[printer]);
45: 1 IF PufferLeer
46: 1 THEN writeln('Puffer leer')
47: 1 ELSE writeln('Zeichen in Puffer');
48: 1 writeln
49: 1 END;
50: 0
51: 0 PROCEDURE SendeZeichen(c : char); (*Schreibt ein Zeichen in den Sendepufer*)
52: 0 BEGIN
53: 1 SchreibInPuffer(c);
54: 1 IF c=#13
55: 1 THEN IF autolinefeed
56: 1 THEN SchreibInPuffer(#10);
57: 1 END;
58: 0
59: 0 PROCEDURE SchickeZeichen; (*Schickt ein Zeichen ber RS232, falls Sendepuffer nicht leer*)
60: 0 VAR c : char;
61: 0 BEGIN
62: 1 IF DarfSenden THEN
63: 1 IF NOT PufferLeer THEN
64: 1 BEGIN
65: 2 HolVonPuffer(c);
66: 2 write(AUX,c);
67: 2 IF echo THEN write(c);
68: 2 IF printer THEN write(LST,c);
69: 2 END
70: 1 END;
71: 0
72: 0 PROCEDURE upload; (*Schreibt alle empfangenen Zeichen in einen Puffer, der
73: 0 anschliessend abgespeichert werden kann*)
74: 0 VAR f : FILE; fn : STRING[14];
75: 0 z : integer;
76: 0 p : ARRAY[0..UpLoadKap] OF char;
77: 0 BEGIN
78: 1 fillchar(p,sizeof(p),AZ);
79: 1 writeln('Einlesen laeuft ! Ende mit ^Q');
80: 1 z:=0; lowvideo;
81: 1 REPEAT
82: 2 IF ZeichenVorhanden
83: 2 THEN BEGIN read(aux,ein); p[z]:=ein; write(ein); z:=succ(z) END;
84: 2 IF keypressed THEN
85: 2 BEGIN
86: 3 read(kbd,aus);
87: 3 CASE aus OF
88: 4 ^E : echo:=NOT echo;
89: 4 ^Q ;
90: 4 ^A : autolinefeed:=NOT autolinefeed;
91: 4 ^B : SchreibStatus
92: 4 ELSE SendeZeichen(aus)
93: 4 END (*case*)
94: 3 END;
95: 2 SchickeZeichen;
96: 2 UNTIL (aus=^Q) OR (z>UpLoadKap);
97: 1 normvideo;
98: 1 write('Name des Files (RETURN = nicht abspeichern) : '); readln(fn);
99: 1 IF fn<>" THEN
100: 1 BEGIN
101: 2 assign(f,fn);
102: 2 rewrite(f);
103: 2 blockwrite(f,p,(z MOD 128)+1);
104: 2 close(f);
105: 2 writeln('Abspeichern beendet.')
106: 2 END
107: 1 END;
108: 0
109: 0 PROCEDURE download; (*Sendet Diskettenf i le*)
110: 0 VAR f : text; fn : STRING[14]; c : char;
111: 0 BEGIN
112: 1 write('Name des zu sendenden Files : '); readln(fn);
113: 1 assign(f,fn);
114: 1 {$1-} reset(f)
115: 1 IF IOResult<>0
116: 1 THEN writeln('File existiert nicht!')
117: 1 ELSE WHILE NOT eof(f) DO
118: 1 BEGIN
119: 2 WHILE PufferVoll AND (NOT KeyPressed) DO SchickeZeichen;
120: 2 IF KeyPressed
121: 2 THEN BEGIN read(kbd,c); IF c="Z THEN exit END
122: 2 ELSE IF NOT PufferVoll
123: 2 THEN BEGIN read(f,c); SchreibInPuffer(c) END
124: 2 END;
125: 1 close(f)
126: 1 END;
127: 0
128: 0 BEGIN (*Hauptprogramm*)
129: 1 ClrScr; writeln('MINIMOD'); writeln;
130: 1 InitPuffer;
131: 1 REPEAT
132: 2 IF ZeichenVorhanden THEN
133: 2 BEGIN read(aux,ein); write(ein); IF printer THEN write(LST,ein) END;
134: 2 IF keypressed THEN
135: 2 BEGIN
136: 3 read(kbd,aus);
137: 3 IF aus=^P THEN
138: 3 BEGIN
139: 4 Optionen;
140: 4 read(kbd,aus);
141.- 4 CASE aus OF
142: 5 ^U : upload;
143: 5 ^D : download;
144: 5 ^L : printer:=NOT(printer);
145: 5 ^E : echo:=NOT echo;
146: 5 ^A : autolinefeed:=NOT autolinefeed;
147: 5 ^S : SchreibStatus;
148: 5 ^R : WHILE NOT PufferLeer DO HolVonPuffer(ein);
149: 5 ^Z halt
150: 5 ELSE SendeZeichen(aus)
151: 5 END
152: 4 END ELSE SendeZeichen(aus)
153.- 3 END;
154: 2 SchickeZeichen (*sendet ein Zeichen aus dem Puffer*)
155: 2 UNTIL false (*Endlos•Schleife*)
156: 1 END.
Listing of COMHEX.PAS
1: 0 {****************************************************************************}
2: 0 {* Programm zu Erzeugung von Intel-Hex-Files aus COM-Dateien *}
3: 0 {****************************************************************************}
4: 0
5: 0 PROGRAM ComHex; {konvertiert Com-Files in Intel-Hex-Files}
6: 0
7: 0 CONST HexZiffer : ARRAY[0..15] OF char = '0123456789ABCDEF';
8: 0 MaxPuffer = 64;
9: 0
10: 0 TYPE HexZahl = STRING[4];
11: 0
12: 0 VAR FileName : STRING[14];
13: 0 ComFile : FILE;
14: 0 HexFile : text;
15: 0 Size : integer;
16: 0 CheckSum : integer;
17: 0 Puffer : ARRAY[0..8191] OF byte;
18: 0 TextPuf : ARRAY[1..MaxPuffer,0..3] OF STRING[75];
19: 0 Seite : integer;
20: 0 max,low : integer;
21: 0
22: 0 FUNCTION HexByte(x:integer) : HexZahl;
23: 0 BEGIN
24: 1 HexByte:=HexZifferl(lo(x) SHR 4)]+HexZiffer[(lo(x) AND 15)]
25: 1 END;
26: 0
27: 0 FUNCTION HexWord(x:integer) : HexZahl;
28: 0 BEGIN
29: 1 HexWord:=HexByte(Hi(x))+HexByte(lo(x))
30: 1 END;
31: 0
32: 0 PROCEDURE SchreibSeite(Nummer : integer);
33: 0 VAR i,j,b : integer; line : STRING[75];
34: 0 BEGIN
35: 1 FOR i:=0 TO 3 DO BEGIN
36: 2 line:='20'+HexWord($80+((Nummer SHL 7)+(i SHL 5)))+'00';
37: 2 CheckSum:=32+((Nummer+1) SHR 1)+(i SHL 5)+((nummer+1) AND 1) SHL 7;
38: 2 FOR j:=0 TO 31 DO BEGIN b:=Puffer[((Seite-low-1) SHL 7)+(i SHL 5)+j];
39: 3 line:=line+HexByte(b);
40: 3 CheckSum:=CheckSum+b; END;
41: 2 TextPuf[Seite-low,i]:=':'+line+HexByte(256-1o(CheckSum));
42: 2 END;
43: 1 END;
44: 0
45: 0 PROCEDURE SchreibPuffer(x:integer);
46: 0 VAR i,j : integer;
47: 0 BEGIN
48: 1 FOR i:=1 TO x DO FOR j:=0 TO 3 DO writeln(HexFile,TextPuf[i,j])
49: 1 END;
50: 0
51: 0 BEGIN {Hauptprogramm}
52: 1 write('Name des Programms : '); readln(FileName);
53: 1 IF pos('.',FileName)<>0
54: 1 THEN FileName:=copy(FileName,l,pos('.',FileName)-1);
55: 1 assign(ComFile,FileName+'.COM'); {$1-} reset(ComFile) {$1+};
56: 1 IF IOresult=0 THEN
57: 1 BEGIN
58: 2 assign(HexFile,FileName+'.HEX'); rewrite(HexFile);
59: 2 Size:=FileSize(ComFile);
60: 2 max:=MaxPuffer; low:=0;
61: 2 WHILE low<Size DO
62: 2 BEGIN
63: 3 IF Size-low<max THEN max:=Size-low; writeln(low:5,Size:5,max:5);
64: 3 blockread(ComFile,Puffer,max);
65: 3 FOR Seite:=1+low TO low+max DO SchreibSeite(Seite);
66: 3 SchreibPuffer(max);
67: 3 low:=low+max
68: 3 END;
69: 2 close(ComFile); writeln(HexFile,':0000000000'); close(HexFile)
70: 2 END
71: 1 END.
Listing of COMSEND.PAS
1: 0 {****************************************************************************}
2: 0 {* COMSEND *}
3: 0 (****************************************************************************)
4: 0 PROGRAM COMSEND;
5: 0
6: 0 {Arbeitet zusammen mit COMREC zum Ueberspielen von COM- und anderen Files
7: 0 Uebertraegt die Daten nibbleweise und ist deshalb auch bei
8: 0 7-BIT-Uebertragung einsetzbar.}
9: 0
10: 0 VAR fname : STRING[14];
11: 0 comfile : FILE;
12: 0 aus : char;
13: 0 PufferZeiger,
14: 0 FileGroesse,
15: 0 BlockZaehler : integer;
16: 0 Puffer : ARRAY[0-16383] OF Byte;
17: 0 i,j : Byte;
18: 0 LONibble,
19: 0 HINibble : 32..47;
20: 0
21: 0 BEGIN
22: 1
23: 1 write('Name des zu sendenden Files : '); read(fname);
24: 1 {$I-} assign(comfile,fname); reset(comfile) {$1+};
25: 1 IF IOresult<>0 THEN
26: 1 BEGIN writeln('File existiert nicht!'); halt END;
27: 1
28: 1 ClrScr;
D9: 1 writeln('Gesendet wird : ',fname);
30: 1 FileGroesse:=FileSize(comfile);
31: 1 writeln('Filegroesse : ',FileGroesse,' CP/M-Sektoren');
32: 1 write(aux,chr(32+FileGroesse DIV 64)); read(aux,aus);
33: 1 write(aux,chr(32+FileGroesse MOD 64)); read(aux,aus);
34: 1 gotoxy(5,5); write('wird uebertragen.');
35: 1 BlockZaehler:=1;
36: 1 WHILE FileGroesse>0 DO BEGIN
37: 2 IF FileGroesse>=128 THEN PufferZeiger:=128
38: 2 ELSE PufferZeiger:=FileGroesse MOD 128;
39: 2 FileGroesse:=FileGroesse-PufferZeiger;
40: 2 Blockread(comfile,Puffer,PufferZeiger);
41: 2 FOR j:=0 TO PufferZeiger-1 DO
42: 2 BEGIN
43: 3 gotoxy(1,5); write(BlockZaehler:3);
44: 3 FOR i:=0 TO 127 DO
45: 3 BEGIN
46: 4 LONibble:=32 OR Puffer[(j SHL 7)+i] AND 15;
47: 4 HINibble:=32 OR Puffer[(j SHL 7)+i] SHR 4;
48: 4 write(aux,chr(HINibble),chr(LONibble))
49: 4 END;
50: 3 read(aux,aus); BlockZaehler:=succ(BlockZaehler)
51: 3 END
52: 2 END;
53: 1 close(comfile);
54: 1 gotoxy(1,6); writeln('Uebertragung beendet')
55: 1 END.
Listing of COMREC.PAS
1: 0 (****************************************************************************)
2: 0 (* COMREC *}
3: 0 (****************************************************************************)
4: 0 PROGRAM COMREC;
5: 0
6: 0 {Ein Programm zum Ueberspielen von COM- und anderen Dateien
7: 0 Arbeitet nibbleweise und funktioniert daher auch bei
8: 0 7-Bit-Uebertragung. Baudrate ist nicht kritisch.}
9: 0
10: 0 VAR fname : STRING[14];
11: 0 comfile : FILE;
12: 0 BlockZaehler,
13: 0 FileGroesse : integer;
14: 0 Puffer : ARRAY[0..16383] OF Byte;
15: 0 ein : char;
16: 0 count : Byte;
17: 0 Block : ARRAY[0..255] OF char;
18: 0
19: 0 PRDCEDURE liesBlock;
20: 0 VAR i : Byte;
21: 0 BEGIN
22: 1 FOR i:=0 TO 255 DO read(aux,Block[i])
23: 1 END;
24: 0
25: 0 PROCEDURE SchreibInPuffer;
26: 0 VAR i : Byte;
27: 0 BEGIN
28: 1 FOR i:=0 TO 127 DO Puffer[(((BlockZaehler-1) AND 127) SHL 7)+i]:=
29: 1 ((ord(Block[i SHL 1]) AND 15) SHL 4) OR (ord(Block[(i SHL 1)+1]) AND
30: 1 END;
31: 0
32: 0
33: 0 BEGIN
34: 1 ClrScr;
35: 1 write('Name des Files : '); readln(fname);
36: 1 assign(comfile,fname);
37: 1 ($I-} reset(comfile) {$1+};
38: 1 IF IOresult=0 THEN
39: 1 BEGIN write('File existiert bereits! Loeschen (J/N) ? ');
40: 2 REPEAT read(kbd,ein) UNTIL ein IN ['j','J','n','N'];
41: 2 IF ein IN ['n','N'] THEN halt
42: 2 END;
43: 1 rewrite(comfile);
44: 1 writeln('Fertig zur Uebernahme.');
45: 1 read(aux,ein); FileGroesse:=(ord(ein)-32)*64; write(aux,ein);
46: 1 read(aux,ein); FileGroesse:=FileGroesse+ord(ein)-32;
47: 1 write(aux,ein);
48: 1 write('Filegroesse : ',FileGroesse,' CP/M-Sektoren');
49: 1 gotoxy(5,5); write('wird uebertragen.');
50: 1 FOR BlockZaehler:=1 TO FileGroesse DO BEGIN
51: 2 gotoxy(1,5); write(BlockZaehler:3);
52: 2 liesBlock;
53: 2 SchreibinPuffer;
54: 2 IF BlockZaehler MOD 128 = 0 THEN BlockWrite(comfile,Puffer,128);
55: 2 write(aux,ein)
56: 2 END;
57: 1 BlockWrite(comfile,Puffer,FileGroesse MOD 128);
58: 1 close(comfile);
59: 1 gotoxy(1,6); writeln('Uebertragung beendet.');
60: 1 END.
Listing of CPM-80.BIB
1: 0 (*****************************************************************************************)
2: 0 (* Bibliotheks-Modul CPM-80.BIB *)
3: 0 (* Wichtige Betriebssystem-Prozeduren fuer CPM-80 *)
4: 0 (* Laufwerkscode : 0=Bezugslaufwerk, 1=A:, 2=B ... *)
5: 0 (* c SpeicherEinheit (real) fuer MemAvail und MaxAvail *)
6: 0 (* p DiskReset setzt Disketensystem zurueck *)
7: 0 (* p DiskAnmelden(d) definiert d als Bezugslaufwerk *)
8: 0 (* f Aktlaufwerk gibt Bezugslaufwerk zurueck *)
9: 0 (* f ErsterEintrag(FCB,DMA):byte sucht ersten Directory-Eintrag, der auf *)
10: 0 (* den File-Control-Block passt. Ergebnis in DMA, falls Wert<>255 *)
11: 0 (* f NaechsterEintrag:byte sucht naechsten passenden Eintrag *)
12: 0 (****************************************************************************)
13: 0
14: 0 CONST SpeicherEinheit 1.0; (wird gebraucht fuer MemAvail etc.)
15: 0
16: 0 PROCEDURE DiskReset;
17: 0 BEGIN
18: 1 BDOS(13)
19: 1 END;
20: 0
21: 0 PROCEDURE DiskAnmelden(drive:byte);
22: 0 BEGIN
23: 1 IF drive>0 THEN BDOS(14,(drive-1) AND 15)
24: 1 END;
25: 0
26: 0 FUNCTION AktLaufwerk : byte;
27: 0 BEGIN
28: 1 AktLaufwerk:=BDOS(25)+1
29: 1 END;
30: 0
31: 0 FUNCTION ErsterEintrag(VAR FCB; VAR DMA) : byte;
32: 0 BEGIN
33: 1 BDOS(26,addr(DMA));
34: 1 ErsterEintrag:=BDOS(17,addr(FCB))
35: 1 END;
36: 0
37: 0 FUNCTION NaechsterEintrag : byte;
38: 0 BEGIN
39: 1 NaechsterEintrag:=BDOS(18)
40: 1 END;
Listing of PUFFER.BIB
1: 0 (****************************************************************************)
2: 0 (* Bibliotheks-Modul PUFFER.BIB *)
3: 0 (* Listenoperationen fuer Puffer-Listen *)
4: 0 (* Setzt das Vorhandensein des Typs 'Pufferinhalt' varaus *)
5: 0 (* (t Puffer definiert einer FIFO-Speicherstruktur) *)
6: 0 (* (t PufferEintrag) *)
7: 0 (* (v PufferAnfang, PufferEnde : Puffer) *)
8: 0 (* f PufferVoll : boolean wird wahr, wenn Puffer ueberlauft *)
9: 0 (* v PufferLeer : boolean wird wahr, wenn kein Element im Puffer *)
10: 0 (* p InitPuffer initialister PufferAnfang- und Ende sowie Pufferleer *)
11: 0 (* p SchreibInPuffer(E : Pufferinhalt) prueft nicht auf Ueberlauf *)
12: 0 (* p HolVonPuffer(var E : Pufferinhalt) E undefiniert, falls PufferLeer *)
13: 0 (* Alle drei Prozeduren veraendern PufferVoll und PufferLeer *)
14: 0
15: 0
16: 0 TYPE Puffer = APufferEintrag;
17: 0 PufferEintrag = RECORD
18: 1 Eintrag : Pufferinhalt;
19: 1 Naechster : Puffer
20: 1 END;
21: 0
22: 0 VAR PufferAnfang,
23: 0 PufferEnde : Puffer;
24: 0 PufferLeer : boolean;
25: 0
26: 0 FUNCTION PufferVoll : boolean;
27: 0 CONST MemEinheit = 16.0; (*1.0 bei CP/M-80*)
28: 0 VAR PufferAvail : real;
29: 0 BEGIN
30: 1 IF MemAvail<0
31: 1 THEN PufferAvail:=MemEinheit*(65536.0+MemAvail)
32: 1 ELSE PufferAvail:=MemEinheit*MemAvail;
33: 1 Puf ferVoll:=Puf ferAvail<SizeOf(Puf ferEintrag)
34: 1 END;
35: 0
36: 0 PROCEDURE InitPuffer;
37: 0 BEGIN
38: 1 PufferAnfang:=NIL; PufferEnde:=NIL; PufferLeer:=true;
39: 1 END;
40: 0
41: 0 PROCEDURE SchreibInPuffer(E : Pufferinhalt);
42: 0 VAR p : Puffer;
43: 0 BEGIN
44: 1 IF NOT PufferVoll THEN
45: 1 BEGIN
46: 2 new(p); PufferLeer:=false;
47: 2 WITH p^ DO BEGIN Eintrag:=E; Naechster:=NIL END;
48: 2 IF PufferEnde<>NIL
49: 2 THEN PufferEnde^.Naechster=p
50: 2 ELSE IF PufferAnfang<>NIL THEN PufferAnfangA.Naechster:=p
51: 2 ELSE PufferAnfang:=p;
52: 2 PufferEnde:=p
53: 2 END
54: 1 END;
55: 0
56: 0 PROCEDURE HolVonPuffer(VAR E : Pufferinhalt);
57: 0 VAR p : Puffer;
58: 0 BEGIN
59: 1 IF PufferAnfang=NIL
60: 1 THEN PufferLeer:=true
61: 1 ELSE BEGIN
62: 2 p:=PufferAnfang; E:=p^.Eintrag; PufferAnfang:=p^.Naechster;
63: 2 dispose(p); PufferLeer:=PufferAnfang=NIL;
64: 2 IF PufferLeer THEN PufferEnde:=NIL
65: 2 END
66: 1 END;
|
