IMPLEMENTATION MODULE Serial;

              (* * * * * * * * * * * * * * * * * * * * * * *)
              (*                                           *)
              (* General Serial Port Support Module.       *)
              (* (c) Copyright 1986 by Steve Faiwiszewski. *)
              (*                                           *)
              (* This program may be freely distributed    *)
              (* for non-commercial use only.  It may not  *)
              (* be sold.                                  *)
              (*                                           *)
              (* Please leave this notice intact.          *)
              (*                                           *)
              (* * * * * * * * * * * * * * * * * * * * * * *)

(*    4/5/87 Converted to Benchmark Modula 2 by Art Steinmetz

       Changed some Names, MODULE origins and cases (subtle: ioSer
         became IOSer).
       Adjusted references to IOStdReq.  TDI IOStdReq contains
         IORequest record.  Benchmark duplicates IORequest fields
	 in IOStdReq.
       IO parameters now passed as pointers.
       String literals now passed by value, not by reference and
          compiler flag $D- used.
       Literal 0 (zero) must be 0D to compare to LONG<anything>.
       32K ARRAY size limitation forced change of all buffer size
          references from LONGCARD to CARDINAL.
*)

FROM Termination  IMPORT AddTerminator, ExitGracefully;
FROM SerialDevice IMPORT SerialName, SDCmdSetParams, SDCmdQuery, IOExtSer,
                         SerFlagsSet, SerShared, SerXDisabled;
FROM PortsUtil    IMPORT CreatePort, DeletePort;
FROM IODevices     IMPORT IORequestPtr,DoIO, SendIO, WaitIO, CheckIO, CmdWrite,
                         CmdRead, OpenDevice, CloseDevice;
FROM IODevicesUtil IMPORT CreateExtIO, DeleteExtIO;
FROM TermInOut    IMPORT WriteString, WriteLn;
FROM SYSTEM       IMPORT ADDRESS, BYTE, ADR, TSIZE;

CONST
  ReadPortName  = "ReadMySerial";
  WritePortName = "WriteMySerial";


TYPE
   IOExtSerPtr = POINTER TO IOExtSer;

VAR
   ReadRequest, WriteRequest : IOExtSerPtr;
   SerIsOpen : BOOLEAN;

PROCEDURE Cleanup(n: CARDINAL);
BEGIN
  IF n >= 5 THEN
      DeleteExtIO(IORequestPtr(WriteRequest))
  END;
  IF n >= 4 THEN
      DeletePort(WritePort^)
  END;
  IF n >= 3 THEN
      CloseDevice(ReadRequest)
  END;
  IF n >= 2 THEN
      DeleteExtIO(IORequestPtr(ReadRequest))
  END;
  IF n >= 1 THEN
      DeletePort(ReadPort^)
  END;
END Cleanup;

(* $D- *)
PROCEDURE Abort(msg : ARRAY OF CHAR; n : CARDINAL);

BEGIN
    WriteLn;
    WriteString(msg); WriteLn;
    IF n > 0 THEN Cleanup(n) END;
    ExitGracefully(n)
END Abort;
(* $D+ *)
    
PROCEDURE OpenSer(BaudRate : LONGCARD;
                  StopBits, BLength : BYTE;
                  XON, XOFF, IND, ACK : CHAR);
VAR
   Result : LONGINT;
   CtlChar : ARRAY[0..3] OF CHAR;


BEGIN
 IF NOT SerIsOpen THEN
      (* Create the read port and call it 'ReadMySerial' *)
    ReadPort := CreatePort(ADR(ReadPortName),0);
    IF ReadPort = NIL THEN Abort('Could not create ReadPort!',0) END;

    ReadRequest := CreateExtIO(ReadPort^,TSIZE(IOExtSer));
    IF ReadRequest = NIL THEN
       Abort('Could not create ReadRequest!',1)
    END;
    ReadRequest^.ioSerFlags := SerFlagsSet{SerShared,SerXDisabled};

    IF OpenDevice(ADR(SerialName),0,ReadRequest,0D) <> 0D THEN
       Abort('Could not open Serial device for read!',2)
    END;

    WritePort := CreatePort(ADR(WritePortName),0);
    IF WritePort = NIL THEN Abort('Could not create WritePort!',3) END;

    WriteRequest := CreateExtIO(WritePort^,TSIZE(IOExtSer));
    IF WriteRequest = NIL THEN
       Abort('Could not create WriteRequest!',4)
    END;

(* now, since ReadRequest is all set up, but WriteRequest isn't, *)
(* simply copy WriteRequest from ReadRequest, but point          *)
(* WriteRequest's reply port to its own port.                    *)

    WriteRequest^ := ReadRequest^;
    WriteRequest^.IOSer.ioMessage.mnReplyPort := WritePort;

    WITH ReadRequest^ DO
        ioSerFlags := SerFlagsSet{SerShared,SerXDisabled};
        ioBaud := BaudRate;
        ioStopBits := StopBits;
        ioReadLen := BLength;
        ioWriteLen := BLength;
        CtlChar[0] := XON;
        CtlChar[1] := XOFF;
        CtlChar[2] := IND;
        CtlChar[3] := ACK;
        ioCtlChar  := LONGCARD(CtlChar);
        IOSer.ioCommand := SDCmdSetParams;
    END;
    Result := DoIO(ADR(ReadRequest^.IOSer));
    IF Result <> 0D THEN
       Abort('** Error during OpenSer: Could not change parameters **',6)
    END;
    SerIsOpen := TRUE
  END
END OpenSer;

PROCEDURE CloseSer;
BEGIN
    IF SerIsOpen THEN
	Cleanup(99);
	SerIsOpen := FALSE;
    END;
END CloseSer;

PROCEDURE SerWrite(VAR Buffer : ARRAY OF BYTE; Length: CARDINAL);
(* Write 'Length' number of bytes from 'Buffer' to the serial port *)
VAR
   Result : LONGINT;
BEGIN
   WITH WriteRequest^ DO
       IOSer.ioCommand := CmdWrite;
       IOSer.ioData := ADR(Buffer);
       IOSer.ioLength := LONGCARD(Length);
   END;
(*   Result := DoIO(IORequestPtr(WriteRequest)); *)
   Result := DoIO(ADR(WriteRequest^.IOSer));
   IF Result <> 0D THEN 
      WriteString('** Error during SerWrite **'); WriteLn
   END;
END SerWrite;

PROCEDURE SerRead(VAR Buffer : ARRAY OF BYTE; Length : CARDINAL);
(* Read 'Length' number of bytes from 'Buffer' from the serial port *)
VAR
   Result : LONGINT;
BEGIN
   WITH ReadRequest^ DO
       IOSer.ioCommand := CmdRead;
       IOSer.ioData := ADR(Buffer);
       IOSer.ioLength := LONGCARD(Length);
   END;
   Result := DoIO(ADR(ReadRequest^.IOSer));
   IF Result <> 0D THEN 
      WriteString('** Error during SerRead **'); WriteLn
   END;
END SerRead;

PROCEDURE QueueSerRead(VAR c : BYTE);
(* Queue up (asynchrously) a request to read one byte into 'c' *)
BEGIN
   WITH ReadRequest^ DO
       IOSer.ioCommand := CmdRead;
       IOSer.ioData := ADR(c);
       IOSer.ioLength := 1;
   END;
   SendIO(ADR(ReadRequest^.IOSer));
END QueueSerRead;

PROCEDURE GotSerialChar() : BOOLEAN;
BEGIN
   RETURN CheckIO(ADR(ReadRequest^.IOSer)) <> NIL;
END GotSerialChar;

PROCEDURE SynchronizeIO;
VAR
    Result : LONGINT;
BEGIN
    Result := WaitIO(ADR(ReadRequest^.IOSer));
    IF Result <> LONGINT(0) THEN
       WriteString('** Error during WaitIO in SynchronizeIO **');
       WriteLn
    END;
END SynchronizeIO;

PROCEDURE ProcessSerMessage(VAR Buffer : ARRAY OF BYTE; Length : CARDINAL);
(* Wait for the asynchronous read request to complete, and read 'Length' *)
(* bytes into 'Buffer'                                                   *)
VAR
    Result : LONGINT;
BEGIN
    Result := WaitIO(ADR(ReadRequest^.IOSer));
    IF Result = LONGINT(0) THEN
       SerRead(Buffer,Length)
    ELSE
       WriteString('** Error during WaitIO in ProcessSerMessage **');
       WriteLn
    END;
END ProcessSerMessage;

PROCEDURE QuerySer() : CARDINAL;
(* Returns the number of characters that are waiting to be read from the *)
(* serial port.                                                          *)
VAR
   Result : LONGINT;
BEGIN
    WITH ReadRequest^ DO
       IOSer.ioCommand := SDCmdQuery;
       Result := DoIO(ADR(ReadRequest^.IOSer));
       IF Result <> 0D THEN 
          WriteString('** Error during SerRead **'); WriteLn
       END;
       RETURN(CARDINAL(IOSer.ioActual))
   END;
END QuerySer;

PROCEDURE BailOut;
BEGIN
    IF SerIsOpen THEN CloseSer END;
END BailOut;

BEGIN
    SerIsOpen := FALSE;
    AddTerminator(BailOut);
END Serial.