Home
Impressum
Computer
Terminal
Schwäne
ZFEST2006
PASCAL
TTL
Z180
Bücher
 



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;

 

 

 

 

 

 

 

 

 
Top