Power-Programmierung/CD1.mdf/pascal/das_buch/remote/pardata.pas

Pascal/Delphi Source File | 1993-08-10 | 30.8 KB | 1,213 lines

(* ====================================================== *)
(*                     PARDATA.PAS                        *)
(*         (c) 1993 Ralf Hensmann & DMV-Verlag            *)
(* ====================================================== *)
{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R-,S+,T-,V+,X+,Y+}
{$M 16384,0,655360}

UNIT ParData;

INTERFACE

{$DEFINE LapLink}
{$DEFINE Debug}

USES Dos;

  FUNCTION GetLPTAdress(LPTNr : BYTE) : WORD;
  (* Emittelt laut BIOS die Adresse der parallelen        *)
  (* Schnittstelle. Achtung: Die Ermittlung funkioniert   *)
  (* nicht immer, wenn das Kabel bereits beim Booten      *)
  (* die Rechner verbindet. (LPT1=1, LPT2 = 2, ...        *)

  PROCEDURE UnitInit(LPTAdress : WORD);
  (* Initialisiert die parallele Schnittstelle            *)

  (* Die Sende- und Empfangsroutinen sind aus Geschwindig-*)
  (* keitsgründen in drei Einzelroutinen aufgespalten.    *)
  (* Mit den Startroutinen (StartSend und StartReceive)   *)
  (* wird die Synchronisation hergestellt. Die eigent-    *)
  (* liche Übertragung geschieht mit SendBlock bzw.       *)
  (* ReceiveBlock, die neben der Pufferadresse die Größe  *)
  (* des Blocks enthalten. Ist der Empfängerblock zu      *)
  (* klein, wird das Programm abgebrochen. StopSend und   *)
  (* StopReceive geben den Kanal nach der Übertragung     *)
  (* wieder frei. Sie können (und sollten) mehrere Block- *)
  (* transfers zwischen den Synchronisationsprozeduren    *)
  (* durchführen.                                         *)
  (* Um den TimeOut so allgemein wie möglich zu halten,   *)
  (* überprüfen alle Routinen die Variable LeaveProc^.    *)
  (* Enthält sie den Wert $FF, brechen die Routinen ab.   *)
  (* LeaveProc^ wird automatisch zu Beginn der Routinen   *)
  (* auf den  Wert 0 gesetzt.                             *)

TYPE
  WaitResult   = (UserBreak, ReadyToTransfer);
  TransMode    = (Transfer4, Transfer8);

VAR
  pLeave       : ^BYTE;      { Zeiger auf untersuchte Byte }
  LastResult   : WaitResult; { Letztes Resultat            }
  TransferMode : TransMode;
  (* Gibt die Art der Übertragung (4-Bit oder 8-Bit an).  *)
  (* Liefert erst ein Ergebnis, wenn StartReceive und     *)
  (* StartSend durchgeführt wurden.                       *)
  LastMode     : BYTE;
  (* letztes Mal gesendet oder empfangen ...              *)

  PROCEDURE StartSend;
   (* Synchronisation mit Empfänger herstellen            *)
  PROCEDURE SendBlock(VAR Buf; Size : WORD);
  PROCEDURE SendBlock4(VAR Buf; Size : WORD);
   (* Die eigentliche Kernroutine des Sendens (auch in    *)
   (* der 4-Bit-Version).                                 *)

  PROCEDURE StartReceive;
   (* Synchronisation mit Sender herstellen               *)
  PROCEDURE ReceiveBlock(VAR Buf; Size : WORD);
  PROCEDURE ReceiveBlock4(VAR Buf; Size : WORD);
   (* Die eigentliche Kernroutine des Empfangens (auch in *)
   (* der 4-Bit-Version).                                 *)

  FUNCTION ParaResult : WaitResult;
   (* Ermittelt das Resultat der Datenübertragung.        *)
   (* Bei auftretendem Fehler werden alle Prozeduren      *)
   (* solange ignoriert, bis ParaResult abgefragt ist.    *)

  PROCEDURE SetTimerWatchdog;
  PROCEDURE ClrTimerWatchdog;
   (* Die Prozeduren SetTimerWatchDog und ClrTimerWatchDog*)
   (* bedienen den standardmäßig eingebauten Watchdog,    *)
   (* der durch den Timer-Interrupt ausgelöst wird und    *)
   (* und die Variable LeaveProc jeweils um eins erhöht.  *)
   (* Der Watchdog kann beliebig ein- und ausgeschaltet   *)
   (* werden. Achtung: Da der Watchdog sich in Int8 ein-  *)
   (* hängt, darf zwischen Ein- und Ausschalten dieser    *)
   (* Interrupt nicht verändert werden.                   *)

  PROCEDURE SetKbdWatchdog;
  PROCEDURE ClrKbdWatchdog;
   (* dito für Tastatur                                   *)

IMPLEMENTATION

VAR
  Daten, Status, Steuer : WORD;
  OldInt08Ptr,
  OldInt09Ptr, OldExit  : POINTER;
  OldInt08              : PROCEDURE ABSOLUTE OldInt08ptr;
  OldInt09              : PROCEDURE ABSOLUTE OldInt09Ptr;

  PROCEDURE ColdError(st : STRING);
   (* interne Fehlermeldungen bei falscher Programmierung *)
  BEGIN
    WriteLn(st);
    RunError;
  END;

  FUNCTION GetLPTAdress(LPTNr : BYTE) : WORD;
    (* Ermittlung der LPTAdresse des Ports                *)
  BEGIN
    GetLPTAdress := MemW[Seg0040:$08+2*(LPTNr-1)];
  END;

  PROCEDURE UnitInit(LPTAdress : WORD);
    (* Initialisierung der Schnittstelle                  *)
  BEGIN
    (* Adresse aus dem ROM-BIOS-Speicherbereich holen     *)
    Daten  := LPTAdress;
    Status := Daten+1;
    Steuer := Daten+2;
    (* Ports auf Lesen vorbereiten *)
    Port[Steuer] := $4;
    Port[Status] := $0;
    Port[Daten ] := $0;
    (* Noch kein Timeout erreicht  *)
    LastResult   := ReadyToTransfer;
  END;

(* ====================================================== *)
(*            Routinen für LapLink (TM) Kabel             *)
(* ====================================================== *)

{$IFDEF LapLink}

  PROCEDURE SendToReceive;
    (* Sorgt für einen definierten Übergang von Senden zu *)
    (* Empfangen ...                                      *)
  BEGIN
    IF LastResult <> ReadyToTransfer THEN Exit;
    Port[Daten] := 0;
    WHILE (Port[Status] >= $80) AND (pLeave^ <> 255) DO;
      Port[Daten] := $F;
    IF pLeave^= 255 THEN LastResult := ReadyToTransfer;
  END;

  PROCEDURE ReceiveToSend;
    (* dito für Übergang von Empfangen zu Senden ...      *)
  BEGIN
    IF LastResult <> ReadyToTransfer THEN Exit;
    WHILE (Port[Status] < $80) AND (pLeave^ <> 255) DO
      (* nothing *);
    Port[Daten] := $10;
    WHILE (Port[Status] < $F8) AND (pLeave^ <> 255) DO
      (* nothing *);
    IF pLeave^ = 255 THEN LastResult := ReadyToTransfer;
  END;

(* ====================================================== *)
(*   Transfer - Routinen                                  *)

CONST
  CALLB = $F; ECHO = $4; ECHO2 = $9;

  PROCEDURE StartSend; ASSEMBLER;
  (* Synchronisiert mit dem Sender und setzt Strobe-Signal*)
  ASM
    LES  DI,pLeave      { es:di := pLeave }
    SUB  AL,AL
    MOV  ES:[DI],AL
    MOV  BL,0FFH
  @Restart:
    MOV  DX,Steuer
                 { Port[steuer] := 0; Port[daten] := $10; }
    MOV  AL,ECHO2
    OUT  DX,AL
    DEC  DX
    DEC  DX
    MOV  AL,CALLB
    OUT  DX,AL
    INC  DX
  @Loop1:
    CMP  BL,ES:[DI]     { repeat }
    JZ   @Break         { if pLeave^= 255 then break }
    IN   AL,DX
    AND  AL,$F8
    CMP  AL,$80 XOR (ECHO SHL 3)
    JNE  @Loop1
    INC  DX
    MOV  AL,4           { Port[steuer] := 4; }
    OUT  DX,AL
    NOP
    IN   AL,DX
    NOP
    OUT  DX,AL
    MOV  BH,AL
    DEC  DX
    DEC  DX
    MOV  AL,$10 OR CALLB
    OUT  DX,AL
    INC  DX
    MOV  CX,$400
  @Loop2:
    CMP  BL,ES:[DI]     { repeat }
    JZ   @Break         { if pLeave^= 255 then break }
    IN   AL,DX
    AND  AL,$F8
    CMP  AL,$80 XOR (ECHO2 SHL 3)
    JE   @Allright
    LOOP @Loop2
    JMP  @Restart
  @Allright:
    MOV  AL,BH
    AND  AL,$F
    CMP  AL,4
    JNE  @Trans8
    MOV  TransferMode,0
    JMP  @Weiter
  @Trans8:
    MOV  TransferMode,1
  @Weiter:
    MOV  AL,ReadyToTransfer
    JMP  @ProgEnd
  @Break:
    MOV  AL,UserBreak
  @ProgEnd:
    MOV  LastResult,AL
    MOV  LastMode,1
  END;

  PROCEDURE StartReceive; ASSEMBLER;
  (* Synchronisiert mit dem Empfänger und löscht          *)
  (* Strobe-Signal                                        *)
  ASM
    LES  DI,pLeave
    SUB  AL,AL
    MOV  ES:[DI],AL
    MOV  BL,0FFH
  @Restart:
    MOV  DX,Daten     { Port[daten] := 0 }
    SUB  AL,AL
    OUT  DX,AL
    INC  DX
    INC  DX
    MOV  AL,4
    OUT  DX,AL        { Port[steuer] := 4 }
    DEC  DX
  @Loop1:
    CMP  BL,ES:[DI]   { repeat }
    JZ   @Break       { if pLeave^= 255 then break }
    IN   AL,DX
    AND  AL,$F8
    CMP  AL,$80 OR (CALLB SHL 3)
    JNZ  @Loop1
    INC  DX
    IN   AL,DX
    NOP
    NOP
    OUT  DX,AL
    DEC  DX
    DEC  DX
    MOV  AL,ECHO
    OUT  DX,AL
    INC  DX
    MOV  CX,$400
  @Loop2:
    CMP  BL,ES:[DI]   { repeat }
    JZ   @Break       { if pLeave^= 255 then break }
    IN   AL,DX
    AND  AL,$F8
    CMP  AL,(CALLB SHL 3)
    JE   @Allright
    LOOP @Loop2
    JMP  @Restart
  @Allright:
    MOV  AL,ECHO2
    Dec  DX
    OUT  DX,AL
    INC  DX
    INC  DX
    MOV  AL,4
    OUT  DX,AL
    NOP
    NOP
    IN   AL,DX
    AND  AL,$F
    CMP  AL,4
    JNE  @Trans8
    MOV  TransferMode,0
    JMP  @Weiter
  @Trans8:
    MOV  TransferMode,1
  @Weiter:
    MOV  AL,ReadyToTransfer
    JMP  @ProgEnd
  @Break:
    MOV  AL,UserBreak
  @ProgEnd:
    MOV  LastResult,AL
    MOV  LastMode,0
  END;

CONST
  ACK1 = $A;
  ACK2 = $5;

  PROCEDURE SendBlock(VAR Buf; Size : WORD); ASSEMBLER;
    (* Die eigentliche Kernroutine des Sendens. *)
  ASM
    CMP  LastMode,0
    JNZ  @First
    CALL ReceiveToSend
  @First:
    PUSH DS
    MOV  AL,LastResult
    CMP  AL,ReadyToTransfer
    JNE  @ProgEnd
    LES  DI,pLeave        { Registerspeicherung  }
    SUB  AL,AL
    MOV  ES:[DI],AL       { pLeave^:= 0;         }
    MOV  CX,0FF04H
    CLD
  @Restart:
    MOV  AX,Seg @Data
    MOV  DS,AX
    MOV  BX,Size          { cx := (size+1) div 2  }
                          {  Anzahl der Worte     }
    INC  BX
    SHR  BX,1
    MOV  DX,Steuer        { Adr. Schnittstelle   }
    LDS  SI,Buf           { Adresse des Puffers  }
  @LOOP:
    LODSB
    ROR  AL,CL
    OUT  DX,AL            { Steuerleitungen (high) raus }
    DEC  DX
    DEC  DX
    CLC
    RCR  AL,CL
    OUT  DX,AL            { Datenleitungen (low) raus }
    INC  DX
  @ACK1:
    CMP  CH,ES:[DI]
    JZ   @UserBreak
    IN   AL,DX
    AND  AL,$F8
    CMP  AL,$80 OR (ACK1 SHL 3)
    JNE  @ACK1
    INC  DX
    LODSB
    ROR  AL,CL
    OUT  DX,AL            { Steuerleitungen (high) raus }
    DEC  DX
    DEC  DX
    STC
    RCR  AL,CL
    OUT  DX,AL            { Datenleitungen (low) raus }
    INC  DX
  @ACK2:
    CMP  CH,ES:[DI]
    JZ   @UserBreak
    IN   AL,DX
    AND  AL,$F8
    CMP  AL,$80 OR (ACK2 SHL 3)
    JNE  @ACK2
    INC  DX
    SUB  BX,1
    JNZ  @LOOP
  @ProcEnd:
    MOV  AL,ReadyToTransfer { Transfer fertig...      }
    JMP  @ProgEnd
  @UserBreak:
    MOV  AL,UserBreak
  @ProgEnd:
    POP  DS
    MOV  LastResult,AL
    MOV  LastMode,1
  END;

  PROCEDURE ReceiveBlock(VAR Buf; Size : WORD); ASSEMBLER;
    (* Die eigentliche Kernroutine des Empfangens. *)
  ASM
    CMP  LastMode,1
    JNZ  @First
    CALL SendToReceive
  @First:
    PUSH DS
    MOV  AL,LastResult
    CMP  AL,ReadyToTransfer
    JNE  @ProgEnd
    LDS  SI,pLeave        { Registerspeicherung  }
    SUB  AL,AL
    MOV  [SI],AL          { pLeave^:= 0;         }
    MOV  CX,0FF04H
    CLD
    MOV  DX,Steuer
    MOV  AL,4
    OUT  DX,AL
  @Restart:
    MOV  AX,Seg @Data
    MOV  DS,AX
    MOV  BX,Size
    INC  BX
    SHR  BX,1
    MOV  DX,Status
    LES  DI,Buf
    LDS  SI,pLeave
  @LOOP:
  @Wait1:
    CMP  CH,[SI]
    JZ   @UserBreak
    IN   AL,DX            { status }
    SHL  AL,1
    JNC  @Wait1
    NOP
    NOP
    IN   AL,DX
    SHL  AL,1
    MOV  AH,AL
    INC  DX
    IN   AL,DX            { steuer }
    ROL  AX,CL
    STOSB
    DEC  DX
    DEC  DX
    MOV  AL,ACK1          { Port[daten] := ACK1; }
    OUT  DX,AL
    INC  DX
  @Wait2:
    CMP  CH,[SI]
    JZ   @UserBreak
    IN   AL,DX            { status }
    SHL  AL,1
    JC   @Wait2
    NOP
    NOP
    IN   AL,DX
    SHL  AL,1
    MOV  AH,AL
    Inc  DX
    IN   AL,DX            { steuer }
    ROL  AX,CL
    STOSB
    DEC  DX
    DEC  DX
    MOV  AL,ACK2          { Port[daten] := ACK1;        }
    OUT  DX,AL
    INC  DX
    SUB  BX,1
    JNZ  @LOOP
    MOV  AL,ReadyToTransfer
    JMP  @ProgEnd
  @UserBreak:
    MOV  AL,UserBreak
  @ProgEnd:
    POP  DS
    MOV  LastResult,AL
    MOV  LastMode,0
  END;

  PROCEDURE SendBlock4(VAR Buf; Size : WORD); ASSEMBLER;
    (* Die eigentliche Kernroutine des Sendens. *)
  ASM
    CMP  LastMode,0
    JNZ  @First
    CALL ReceiveToSend
  @First:
    PUSH DS
    MOV  AL,LastResult
    CMP  AL,ReadyToTransfer
    JNE  @ProgEnd
    LES  DI,pLeave        { Registerspeicherung  }
    SUB  AL,AL
    MOV  ES:[DI],AL       { pLeave^:= 0;         }
    MOV  CX,0FF04H
    CLD
  @Restart:
    MOV  AX,Seg @Data
    MOV  DS,AX
    MOV  BX,Size
    MOV  DX,Daten         { Adr. Schnittstelle   }
    LDS  SI,Buf           { Adresse des Puffers  }
  @LOOP:
    LODSB
    SUB  AH,AH
    ROR  AX,CL
    OUT  DX,AL            { Datenleitungen (high) raus }
    INC  DX
  @ACK1:
    CMP  CH,ES:[DI]
    JZ   @UserBreak
    IN   AL,DX
    AND  AL,$F8
    CMP  AL,$80 OR (ACK1 SHL 3)
    JNE  @ACK1
    Dec  DX
    MOV  AL,1
    ROL  AX,CL
    OUT  DX,AL            { Datenleitungen (low) raus }
    INC  DX
  @ACK2:
    CMP  CH,ES:[DI]
    JZ   @UserBreak
    IN   AL,DX
    AND  AL,$F8
    CMP  AL,$80 OR (ACK2 SHL 3)
    JNE  @ACK2
    DEC  DX
    SUB  BX,1
    JNZ  @LOOP
  @ProcEnd:
    MOV  AL,ReadyToTransfer { Transfer fertig...  }
    JMP  @ProgEnd
  @UserBreak:
    MOV  AL,UserBreak
  @ProgEnd:
    POP  DS
    MOV  LastResult,AL
    MOV  LastMode,1
  END;

  PROCEDURE ReceiveBlock4(VAR Buf; Size : WORD); ASSEMBLER;
    (* Die eigentliche Kernroutine des Empfangens. *)
  ASM
    CMP  LastMode,1
    JNZ  @First
    CALL SendToReceive
  @First:
    PUSH DS
    MOV  AL,LastResult
    CMP  AL,ReadyToTransfer
    JNE  @ProgEnd
    LDS  SI,pLeave        { Registerspeicherung  }
    SUB  AL,AL
    MOV  [SI],AL          { pLeave^:= 0;         }
    MOV  CX,0FF04H
    CLD
    MOV  DX,Steuer
    MOV  AL,4
    OUT  DX,AL
  @Restart:
    MOV  AX,Seg @Data
    MOV  DS,AX
    MOV  BX,Size
    MOV  DX,Status
    LES  DI,Buf
    LDS  SI,pLeave
  @LOOP:
  @Wait1:
    CMP  CH,[SI]
    JZ   @UserBreak
    IN   AL,DX            { status }
    SHL  AL,1
    JNC  @Wait1
    NOP
    NOP
    IN   AL,DX
    SHL  AL,1
    SHL  AX,CL            { in ah zwischenspeichern }
    Dec  DX
    MOV  AL,ACK1          { Port[daten] := ACK1;    }
    OUT  DX,AL
    Inc  DX
  @Wait2:
    CMP  CH,[SI]
    JZ   @UserBreak
    IN   AL,DX            { status }
    SHL  AL,1
    JC   @Wait2
    NOP
    NOP
    IN   AL,DX
    SHL  AL,1
    ROR  AX,CL            { zusammenfügen }
    STOSB
    Dec  DX
    MOV  AL,ACK2          { Port[daten] := ACK1;    }
    OUT  DX,AL
    Inc  DX
    SUB  BX,1
    JNZ  @LOOP
    MOV  AL,ReadyToTransfer
    JMP  @ProgEnd
  @UserBreak:
    MOV  AL,UserBreak
  @ProgEnd:
    POP  DS
    MOV  LastResult,AL
    MOV  LastMode,0
  END;

(* ====================================================== *)
(*  Routinen für eigenes Kabel                            *)

{$ELSE}   { IFNDEF LAPLINK }

CONST
  DoStrobe = 5; { Konstanten sind hardwareabhängig }
  NoStrobe = 4;

  PROCEDURE SendToReceive;
    (* Sorgt für einen definierten Übergang von Senden zu *)
    (* Empfangen ...                                      *)
  BEGIN
    IF LastResult <> ReadyToTransfer THEN Exit;
    IF TransferMode = Transfer4 THEN BEGIN
      Port[Daten] := 0;
      WHILE ((Port[Status] AND $8) = 0) AND
             (pLeave^ <> 255) DO (* nothing *);
      Port[Daten] := $70;
    END ELSE BEGIN
      Port[Daten] := 0;
      Port[Steuer] := NoStrobe;
      WHILE NOT Odd(Port[Steuer]) AND (pLeave^ <> 255) DO;
        (* nothing *)
      Port[Daten] := $70;
    END;
    IF pLeave^= 255 THEN LastResult := ReadyToTransfer;
  END;

  PROCEDURE ReceiveToSend;
    (* dito für Übergang von Empfangen zu Senden ...      *)
  BEGIN
    IF LastResult <> ReadyToTransfer THEN Exit;
    IF TransferMode = Transfer4 THEN BEGIN
      WHILE ((Port[Status] AND $8) <> 0) AND
             (pLeave^ <> 255) DO (* nothing *);
      Port[Daten] := 8;
      WHILE (Port[Status] < $F0) AND (pLeave^ <> 255) DO
        (* nothing *);
    END ELSE BEGIN
      WHILE Odd(Port[Steuer]) AND (pLeave^ <> 255) DO
        (* nothing *);
      Port[Steuer] := DoStrobe;
      WHILE (Port[Status] < $F0) AND (pLeave^ <> 255) DO
        (* nothing *);
    END;
  END;

(* ====================================================== *)
(*  Transfer - Routinen                                   *)

  FUNCTION GetByte : BYTE; ASSEMBLER;
    (* empfängt einzelnes Byte                            *)
  ASM
    MOV   DX,Status
    IN    AL,DX
    MOV   AH,AL
    AND   AH,$F8
    INC   DX
    IN    AL,DX
    SHR   AL,1
    AND   AL,$7
    OR    AL,AH
    XOR   AL,$85
  END;

CONST
  NULL     = 0;
  ECHO     = $A8;
  ECHOANS4 = $57;
  ECHOANS8 = $50;
  ECHOOK   = $AF;
        { Konstanten sind algorithmusabhängig }

  PROCEDURE MakeTransfer; ASSEMBLER;
    (* ermittelt aus dem Echobyte die Art des Transfers   *)
  ASM
    CMP   AL,ECHOANS8
    JNZ   @Mode4
    MOV   TransferMode,Transfer8
    JMP   @ProgEnd
  @Mode4:
    MOV   TransferMode,Transfer4
  @ProgEnd:
  END;

  PROCEDURE StartSend; ASSEMBLER;
    (* Synchronisiert mit dem Sender und setzt            *)
    (* Strobe-Signal                                      *)
  ASM
    LES  DI,pLeave      { es:di := pLeave }
    SUB  AL,AL
    MOV  ES:[DI],AL
    MOV  BL,0FFH
  @Restart:
    MOV  DX,Daten       { Port[daten] := echo }
    MOV  AL,ECHO
    OUT  DX,AL
  @Loop1:
    CALL GetByte        { if GetByte = ECHOANSWER goto ok1 }
    CMP  AL,ECHOANS4
    JZ   @Ok1
    CMP  AL,ECHOANS8
    JZ   @Ok1
    CMP  ES:[DI],BL     { if pLeave = 255 then             }
                        {   StartSend := UserBreak; exit;  }
    JNZ  @Loop1
    MOV  AL,UserBreak
    JMP  @ProgEnd
  @Ok1:
    CALL MakeTransfer
    MOV  CX,0400H
    MOV  DX,Daten       { Port[daten] := echo }
    OUT  DX,AL
  @Loop2:
    CALL GetByte        { if GetByte = ECHOOK goto ok2 }
    CMP  AL,ECHOOK
    JZ   @Ok2
    CMP  ES:[DI],BL     { if pLeave = 255 then }
                        {   StartSend := UserBreak; exit; }
    JZ   @Break
    LOOP @Loop2
    JMP  @Restart
  @Break:
    MOV  AL,UserBreak
    JMP  @ProgEnd
  @Ok2:
    MOV  AL,ReadyToTransfer
    MOV  DX,Steuer
    MOV  AL,DoStrobe
    OUT  DX,AL
  @ProgEnd:
    MOV  LastResult,AL
    MOV  LastMode,1
  END;

  PROCEDURE StartReceive; ASSEMBLER;
    (* Synchronisiert mit dem Empfänger und löscht        *)
    (* Strobe-Signal                                      *)
  ASM
    LES  DI,pLeave
    SUB  AL,AL
    MOV  ES:[DI],AL
    MOV  BL,0FFH
  @Restart:
    MOV  DX,Daten     { Port[daten] := 0; }
    MOV  AL,NULL
    OUT  DX,AL
  @Loop1:
    CALL GetByte      { repeat h := GetByte; }
    MOV  AH,AL        { h1 := h; }
    AND  AL,0F8H      { h := h and $F8 }
    CMP  AL,ECHO      { until (h = ECHO) or }
    JZ   @Ok1
    CMP  ES:[DI],BL   { (pLeave^ = 255); }
    JNZ  @Loop1
    MOV  AL,UserBreak { if pLeave^=255 return UserBreak }
    JMP  @ProgEnd
  @Ok1:
    MOV  DX,Daten
                { Port[daten] := ECHOANS8 xor h xor h1; }
    XOR  AL,ECHOANS8
    XOR  AL,AH
    OUT  DX,AL
    MOV  CX,0300H     { i := $300; }
  @Loop2:
    CALL GetByte      { repeat h := GetByte }
    CMP  AL,ECHOANS8  { until (h =ECHOANS8) or }
    JZ   @Ok2
    CMP  AL,ECHOANS4  { (h = ECHOANS4) or }
    JZ   @Ok2
    CMP  ES:[DI],BL   { (pLeave^ = 255); }
    JZ   @Break
    LOOP @Loop2
    JMP  @Restart     { if (--i = 0) then goto restart }
  @Break:
    MOV  AL,UserBreak
    JMP  @ProgEnd
  @Ok2:
    CALL MakeTransfer
    MOV  DX,Daten
    MOV  AL,ECHOOK
    OUT  DX,AL
    MOV  AL,ReadyToTransfer
  @ProgEnd:
    MOV  LastResult,AL
    MOV  LastMode,0
  END;

CONST
  ACK1     = $C8;
  ACK2     = $30;
  ACKError = 7;
  { Konstanten sind algorithmusabhängig  }

  PROCEDURE SendBlock(VAR Buf; Size : WORD); ASSEMBLER;
    (* Die eigentliche Kernroutine des Sendens. *)
  ASM
    CMP  LastMode,0
    JNZ  @First
    CALL ReceiveToSend
  @First:
    PUSH DS
    MOV  AL,LastResult
    CMP  AL,ReadyToTransfer
    JNE  @ProgEnd
    LES  DI,pLeave        { Registerspeicherung  }
    SUB  AL,AL
    MOV  ES:[DI],AL       { pLeave^:= 0;         }
    MOV  BL,0FFH
    CLD
  @Restart:
    POP  DS
    PUSH DS
    MOV  CX,Size          { Anzahl der Worte     }
    Inc  CX
    SHR  CX,1
    MOV  DX,Daten         { Adr. Schnittstelle   }
    LDS  SI,Buf           { Adresse des Puffers  }
  @LOOP:
    LODSW
    OUT  DX,AL            { low-Byte raus        }
    NOP
    NOP
    ADD  DX,2
    MOV  AL,NoStrobe
    OUT  DX,AL            { Strobe löschen          }
    Dec  DX
  @ACK1:                  { repeat                  }
    CMP  BL,ES:[DI]       {   if [es:di]^=$FF then  }
                          {    TimeOut ?            }
    JZ   @UserBreak       {     goto UserBreak      }
                          {   Abbruch der Prozedur  }
    IN   AL,DX            {
          until (Port[status] and $F8) = (ACK1 xor $80) }
    AND  AL,$F8
    CMP  AL,ACK1 XOR $80
    JNE  @ACK1
    Dec  DX
    MOV  AL,AH
    OUT  DX,AL            { High-Byte raus       }
    NOP
    NOP
    ADD  DX,2
    MOV  AL,DoStrobe
    OUT  DX,AL            {  Strobe setzen     }
    Dec  DX
  @ACK2:                  { repeat                    }
    CMP  BL,ES:[DI]       {   if [es:di]^=$FF then    }
                          {   // TimeOut ?            }
    JZ   @UserBreak       {     goto UserBreak        }
                          {  // Abbruch der Prozedur  }
    IN   AL,DX
      { until (Port[status] and $F8) = (ACK2 xor $80) }
    AND  AL,$F8
    CMP  AL,ACK2 XOR $80
    JNE  @ACK2
    Dec  DX
    LOOP @LOOP
  @ProcEnd:
    MOV  AL,ReadyToTransfer { Transfer fertig...      }
    JMP  @ProgEnd
  @UserBreak:
    MOV  AL,UserBreak
  @ProgEnd:
    POP  DS
    MOV  LastResult,AL
    MOV  LastMode,1
  END;

  PROCEDURE ReceiveBlock(VAR Buf; Size : WORD); ASSEMBLER;
    (* Die eigentliche Kernroutine des Empfangens. *)
  ASM
    CMP  LastMode,1
    JNZ  @First
    CALL SendToReceive
  @First:
    PUSH DS
    MOV  AL,LastResult
    CMP  AL,ReadyToTransfer
    JNE  @ProgEnd
    LDS  SI,pLeave        { Registerspeicherung  }
    SUB  AL,AL
    MOV  [SI],AL          { pLeave^:= 0;         }
    MOV  BL,0FFH
    CLD
  @Restart:
    POP  DS
    PUSH DS
    MOV  CX,Size          { Anzahl der Worte     }
    Inc  CX
    SHR  CX,1
    MOV  DX,Steuer        { Strobe-Empfang       }
    LES  DI,Buf           { Adresse des Puffers  }
    LDS  SI,pLeave        { Registerspeicherung  }
  @LOOP:
  @Wait1:                 { repeat                         }
    CMP  BL,[SI]
    JZ   @UserBreak
    IN   AL,DX
    SHR  AL,1
    JC   @Wait1           { until not odd(Port[steuer]);   }
    AND  AL,7
    MOV  AH,AL
    Dec  DX
    IN   AL,DX
           { [es:di]^ := ((Port[status] and $F8) or        }
    AND  AL,$F8
           {              ((Port[steuer] shr 1) and $7))   }
    OR   AL,AH
    XOR  AL,$85     { xor $85;                             }
    STOSB           { inc(di);                             }
    Dec  DX
    MOV  AL,ACK1          { Port[daten] := ACK1;           }
    OUT  DX,AL
    NOP
    NOP
    ADD  DX,2
  @Wait2:                 { repeat                         }
    CMP  BL,[SI]
    JZ   @UserBreak
    IN   AL,DX
    SHR  AL,1
    JNC  @Wait2           { until odd(Port[steuer]);       }
    AND  AL,7
    MOV  AH,AL
    Dec  DX
    IN   AL,DX
           { [es:di]^ := ((Port[status] and $F8) or        }
    AND  AL,$F8
           {              ((Port[steuer] shr 1) and $7))   }
    OR   AL,AH
    XOR  AL,$85           {             xor $85;           }
    STOSB                 { inc(di);                       }
    Dec  DX
    MOV  AL,ACK2          { Port[daten] := ACK1;           }
    OUT  DX,AL
    NOP
    NOP
    ADD  DX,2
    LOOP @LOOP
    SUB  DX,2
    MOV  AL,ReadyToTransfer
    JMP  @ProgEnd
  @UserBreak:
    MOV  AL,UserBreak
  @ProgEnd:
    POP  DS
    MOV  LastResult,AL
    MOV  LastMode,0
  END;

  PROCEDURE SendBlock4(VAR Buf; Size : WORD); ASSEMBLER;
    (* Die eigentliche Kernroutine des Sendens. *)
  ASM
    CMP  LastMode,0
    JNZ  @First
    CALL ReceiveToSend
  @First:
    PUSH DS
    MOV  AL,LastResult
    CMP  AL,ReadyToTransfer
    JNE  @ProgEnd
    LES  DI,pLeave        { Registerspeicherung  }
    SUB  AL,AL
    MOV  ES:[DI],AL       { pLeave^:= 0;         }
    MOV  CX,0FF04H
    CLD
  @Restart:
    POP  DS
    PUSH DS
    MOV  BX,Size          { Anzahl der Bytes     }
    MOV  DX,Daten         { Adr. Schnittstelle   }
    LDS  SI,Buf           { Adresse des Puffers  }
  @LOOP:
    LODSB
    SHL  AX,CL
           { lower 4 Bit zuerst senden (upper in ah) ...   }
    OUT  DX,AL            { (ohne Strobe) }
    Inc  DX
  @ACK1:                  { repeat                         }
    CMP  CH,ES:[DI]       {   if [es:di]^=$FF then         }
                          {     // TimeOut ?               }
    JZ   @UserBreak       {     goto UserBreak             }
                          {     // Abbruch der Prozedur    }
    IN   AL,DX
           { until (Port[status] and $F8) = (ACK1 xor $80) }
    AND  AL,$F8
    CMP  AL,ACK1 XOR $80
    JNE  @ACK1
    Dec  DX
    STC
    RCL  AH,CL
    MOV  AL,AH            { obere 4 Bit mit Strobe-Signal  }
    OUT  DX,AL            { High-Byte raus                 }
    Inc  DX
  @ACK2:                  { repeat                         }
    CMP  CH,ES:[DI]       {   if [es:di]^=$FF then         }
                          {     // TimeOut ?               }
    JZ   @UserBreak       {     goto UserBreak             }
                          {     // Abbruch der Prozedur    }
    IN   AL,DX
           { until (Port[status] and $F8) = (ACK2 xor $80) }
    AND  AL,$F8
    CMP  AL,ACK2 XOR $80
    JNE  @ACK2
    Dec  DX
    SUB  BX,1
    JNZ  @LOOP
  @ProcEnd:
    MOV  AL,ReadyToTransfer
    JMP  @ProgEnd
  @UserBreak:
    MOV  AL,UserBreak
  @ProgEnd:
    POP  DS
    MOV  LastResult,AL
    MOV  LastMode,1
  END;

  PROCEDURE ReceiveBlock4(VAR Buf; Size : WORD); ASSEMBLER;
    (* Die eigentliche Kernroutine des Empfangens. *)
  ASM
    CMP  LastMode,1
    JNZ  @First
    CALL SendToReceive
  @First:
    PUSH DS
    MOV  AL,LastResult
    CMP  AL,ReadyToTransfer
    JNE  @ProgEnd
    LDS  SI,pLeave     { Registerspeicherung  }
    SUB  AL,AL
    MOV  [SI],AL       { pLeave^:= 0;         }
    MOV  CX,0FF04H     { für Bitmaske und Schiebeoperation }
    CLD
  @Restart:
    POP  DS
    PUSH DS
    MOV  BX,Size          { Anzahl der Worte     }
    MOV  DX,Status        { Strobe-Empfang       }
    LES  DI,Buf           { Adresse des Puffers  }
    LDS  SI,pLeave        { Registerspeicherung  }
  @LOOP:
  @Wait1:                 { repeat                         }
    CMP  CH,[SI]
    JZ   @UserBreak
    IN   AL,DX
    AND  AL,8
    JNZ  @Wait1           { until kein Strobe-Signal       }
    NOP    { Schonfrist zur Beruhigung des Leitungspegels  }
    NOP
    NOP
    IN   AL,DX            { und die Daten ins AH-Register  }
    SUB  AH,AH
    SHL  AX,CL
    Dec  DX
    MOV  AL,ACK1          { Port[daten] := ACK1;           }
    OUT  DX,AL
    NOP
    NOP
    Inc  DX
  @Wait2:                 { repeat                         }
    CMP  CH,[SI]
    JZ   @UserBreak
    IN   AL,DX
    AND  AL,8
    JZ   @Wait2           { until Strobe                   }
    NOP
    NOP
    NOP
    IN   AL,DX
    AND  AL,0F0H
    OR   AL,AH            { ... auch 'ne Wiedervereinigung }
    XOR  AL,88H
    STOSB                 { inc(di);                       }
    Dec  DX
    MOV  AL,ACK2          { Port[daten] := ACK1;           }
    OUT  DX,AL
    NOP
    NOP
    Inc  DX
    SUB  BX,1
    JNZ  @LOOP
    Dec  DX
    MOV  AL,ReadyToTransfer
    JMP  @ProgEnd
  @UserBreak:
    MOV  AL,UserBreak
  @ProgEnd:
    POP  DS
    MOV  LastResult,AL
    MOV  LastMode,0
  END;

{$ENDIF}  { eigenes Kabel }

(* ====================================================== *)

  FUNCTION ParaResult : WaitResult;
  BEGIN
    ParaResult := LastResult;
    LastResult := ReadyToTransfer;
  END;

(* = Watchdog-Routinen ================================== *)

  PROCEDURE TimerWatchdog; ASSEMBLER;
  ASM
    PUSH DS          { Register sichern }
    PUSH SI
    PUSH AX
    MOV  AX,Seg @Data
    MOV  DS,AX
    LDS  SI,pLeave   { al := pLeave^ }
    MOV  AL,[SI]
    Inc  AL          { if al <> 255 then LeaveProc^:= al+1 }
    OR   AL,AL
    JZ   @Weiter
    MOV  [SI],AL
  @Weiter:
    PUSHF            { OldInt08; }
    CALL OldInt08
    POP  AX          { Register restaurieren }
    POP  SI
    POP  DS
    IRET
  END;

  PROCEDURE SetTimerWatchdog;
  BEGIN
  {$IFDEF Debug}
    IF (OldInt08ptr <> NIL) THEN
      ColdError('Watchdog bereits initialisiert');
  {$ENDIF}
    GetIntVec($08, OldInt08ptr);
    SetIntVec($08, @TimerWatchdog);
  END;

  PROCEDURE ClrTimerWatchdog;
  VAR
    Test08ptr : POINTER;
  BEGIN
  {$IFDEF Debug}
    IF (OldInt08ptr = NIL) THEN
      ColdError('Watchdog nicht initialisiert');
    GetIntVec($08, Test08ptr);
    IF Test08ptr <> @TimerWatchdog THEN
      ColdError('Zwischenzeitliche Installation eines '+
                'anderen Hooks');
  {$ENDIF}
    SetIntVec($08, OldInt08ptr);
    OldInt08ptr := NIL;
  END;

  PROCEDURE KbdWatchdog; ASSEMBLER;
  ASM
    PUSH DS            { Register sichern }
    PUSH SI
    PUSH AX
    MOV  AX,Seg @Data
    MOV  DS,AX
    LDS  SI,pLeave
    MOV  AL,0FFH
    MOV  [SI],AL
    @Weiter:
    PUSHF              { OldInt09; }
    CALL OldInt09
    POP  AX            { Register restaurieren }
    POP  SI
    POP  DS
    IRET
  END;

  PROCEDURE SetKbdWatchdog;
  BEGIN
  {$IFDEF Debug}
    IF (OldInt09Ptr <> NIL) THEN
      ColdError('Watchdog bereits initialisiert');
  {$ENDIF}
    GetIntVec($09,OldInt09Ptr);
    SetIntVec($09,@KbdWatchdog);
  END;

  PROCEDURE ClrKbdWatchdog;
  VAR Test09ptr : POINTER;
  BEGIN
  {$IFDEF Debug}
    IF (OldInt09Ptr = NIL) THEN
      ColdError('Watchdog nicht initialisiert');
    GetIntVec($09,Test09ptr);
    IF Test09ptr <> @KbdWatchdog THEN
      ColdError('Zwischenzeitliche Installation eines '+
                'anderen Hooks');
  {$ENDIF}
    SetIntVec($09, OldInt09Ptr);
    OldInt09Ptr := NIL;
  END;

  PROCEDURE UnitExit; FAR;
  BEGIN
    IF OldInt08ptr <> NIL THEN
      SetIntVec($08,OldInt08ptr);
    IF OldInt09Ptr <> NIL THEN
      SetIntVec($09,OldInt09Ptr);
    ExitProc := OldExit;
  END;

VAR
  LeaveByte : BYTE;

BEGIN
  OldInt08ptr := NIL;
  OldInt09Ptr := NIL;
  pLeave      := @LeaveByte;
  OldExit     := ExitProc;
  ExitProc    := @UnitExit;
  LastResult  := ReadyToTransfer;
  TransferMode:= Transfer4;
END.
(* ====================================================== *)
(*                 Ende von PARDATA.PAS                   *)