MODULE XYModem;
IMPORT SYSTEM, Objects, Kernel, Streams, Files, Serials, Strings, Commands;
CONST
SOH = 01X; STX = 02X; EOT = 04X; ACK = 06X; EOF = 1AX; NAK = 15X; CAN = 18X; C = 43X;
XModem* = 0; XModem1K* = 1; YModem* = 2;
DoYield = TRUE;
TYPE
Modem* = OBJECT
VAR
W: Streams.Writer; R: Streams.Reader;
F: Files.File;
mode: LONGINT;
timeout: LONGINT;
data: ARRAY 1024 OF CHAR;
error: ARRAY 64 OF CHAR;
done, fail: BOOLEAN;
bytesProcessed-, totalBytes- : LONGINT;
PROCEDURE & Init*(W: Streams.Writer; R: Streams.Reader; F: Files.File; mode: LONGINT);
BEGIN
SELF.W := W; SELF.R := R;
SELF.F := F; SELF.mode := mode; error := ""; done := FALSE
END Init;
PROCEDURE IsDone*() : BOOLEAN;
BEGIN
RETURN done;
END IsDone;
PROCEDURE Await*(VAR err: ARRAY OF CHAR);
BEGIN {EXCLUSIVE}
AWAIT(done); COPY(error, err)
END Await;
PROCEDURE AwaitF*(VAR F: Files.File; VAR err: ARRAY OF CHAR);
BEGIN {EXCLUSIVE}
ASSERT(mode = YModem);
AWAIT(done);
F := SELF.F; COPY(error, err)
END AwaitF;
PROCEDURE Stop;
BEGIN {EXCLUSIVE}
done := TRUE
END Stop;
PROCEDURE Read(VAR ch: CHAR): BOOLEAN;
VAR n: LONGINT; milliTimer : Kernel.MilliTimer;
BEGIN
Kernel.SetTimer(milliTimer, timeout);
REPEAT
n := R.Available();
IF DoYield & (n = 0) THEN Objects.Yield; END;
UNTIL (n > 0) OR Kernel.Expired(milliTimer);
IF n = 0 THEN
error := "timeout"; ch := 0X; RETURN FALSE
END;
R.Char(ch); RETURN R.res = Streams.Ok
END Read;
END Modem;
TYPE
Sender* = OBJECT (Modem)
PROCEDURE YHeader(): LONGINT;
VAR fullname, name, pathname, path: Files.FileName; prefix : ARRAY Files.PrefixLength OF CHAR; len, i, j: LONGINT; ch: CHAR;
BEGIN
F.GetName(fullname); len := F.Length();
Files.SplitName(fullname, prefix, pathname);
Files.SplitPath(pathname, path, name);
i := 0; j := 0; ch := name[0];
WHILE ch # 0X DO
IF ch = ":" THEN j := 0 ELSE data[j] := ch; INC(j) END;
INC(i); ch := name[i]
END;
data[j] := 0X; INC(j);
Strings.IntToStr(len, name);
i := 0; ch := name[0];
WHILE ch # 0X DO
data[j] := ch; INC(j); INC(i); ch := name[i]
END;
IF j < 128 THEN len := 128 ELSE len := 1024 END;
ASSERT(j < len);
WHILE j < len DO data[j] := 0X; INC(j) END;
RETURN len
END YHeader;
PROCEDURE SendFile;
VAR fR: Files.Reader; len, blkn, blk, i, retry: LONGINT; start, ch: CHAR;
PROCEDURE SendData;
VAR crc: LONGINT;
BEGIN
W.Char(start); W.Char(CHR(blk)); W.Char(CHR(255-blk));
W.Bytes(data, 0, blkn); crc := CRC16(data, blkn);
W.Char(CHR(crc DIV 256)); W.Char(CHR(crc MOD 256));
W.Update();
IF Read(ch) THEN
IF ch # ACK THEN
IF (ch = NAK) & (retry < 5) THEN
INC(retry)
ELSE
fail := TRUE; error := "expected ACK"
END
ELSE
blk := (blk + 1) MOD 256; retry := 0
END
ELSE
fail := TRUE
END
END SendData;
BEGIN
timeout := 5000;
i := 0; REPEAT INC(i) UNTIL Read(ch) OR (i > 10);
IF ch = C THEN
error := ""
ELSIF ch # 0X THEN
error := "expected C"; RETURN
ELSE
RETURN
END;
timeout := 10000;
IF mode = YModem THEN
IF YHeader() > 128 THEN start := STX; blkn := 1024 ELSE start := SOH; blkn := 128 END;
blk := 0; SendData();
IF ~(Read(ch) & (ch = C)) THEN error := "expected C"; RETURN END
END;
Files.OpenReader(fR, F, 0); len := F.Length(); totalBytes := len;
fail := FALSE; retry := 0; blk := 1; start := STX; blkn := 1024;
REPEAT
IF retry = 0 THEN
IF (mode = XModem) OR (len < (1024-128)) THEN start := SOH; blkn := 128 END;
fR.Bytes(data, 0, blkn, i); DEC(len, blkn); INC(bytesProcessed, i);
IF (fR.res # Streams.Ok) OR (i < blkn) THEN
WHILE i < blkn DO data[i] := EOF; INC(i) END
END
END;
SendData();
UNTIL (fR.res # Streams.Ok) OR fail;
IF ~fail THEN
W.Char(EOT); W.Update();
IF mode = YModem THEN
IF Read(ch) & ((ch = ACK) OR (ch = NAK)) THEN
W.Char(EOT); W.Update();
IF Read(ch) & ((ch = ACK) OR (ch = C)) THEN
IF (ch = C) OR (Read(ch) & (ch = C)) THEN
start := SOH; blkn := 128; blk := 0;
i := 0; WHILE i < blkn DO data[i] := 0X; INC(i) END;
SendData()
END
END
END
ELSE
IF Read(ch) & (ch = ACK) THEN END
END
ELSE
W.Char(CAN); W.Update()
END
END SendFile;
BEGIN {ACTIVE}
SendFile(); Stop()
END Sender;
Receiver* = OBJECT (Modem)
PROCEDURE YHeader(len: LONGINT; VAR name: ARRAY OF CHAR; VAR size: LONGINT);
VAR i, j: LONGINT; str: ARRAY 12 OF CHAR; ch: CHAR;
BEGIN
size := MAX(LONGINT);
i := 0; j := 0; ch := data[0];
WHILE (i < len) & (ch # 0X) DO
name[j] := ch; INC(j); INC(i); ch := data[i]
END;
name[j] := 0X; INC(i);
IF (i < len) & IsDigit(data[i]) THEN
j := 0; ch := data[i];
WHILE (i < len) & IsDigit(data[i]) DO
str[j] := ch; INC(j); INC(i); ch := data[i]
END;
str[j] := 0X; Strings.StrToInt(str, size)
END
END YHeader;
PROCEDURE ReceiveFile;
VAR name: Files.FileName; fW: Files.Writer; len, blkn, i: LONGINT; ch, ch2: CHAR;
PROCEDURE ReceiveData(): BOOLEAN;
VAR len, crc, crcr: LONGINT;
BEGIN
R.Bytes(data, 0, blkn, len); fail := (R.res # Streams.Ok) OR (len # blkn);
IF ~fail THEN
IF Read(ch) & Read(ch2) THEN
crcr := 256*LONG(ORD(ch)) + LONG(ORD(ch2));
crc := CRC16(data, blkn);
IF crc = crcr THEN
W.Char(ACK); W.Update(); i := (i + 1) MOD 256;
RETURN TRUE
ELSE
W.Char(NAK); W.Update()
END
ELSE
fail := TRUE
END
ELSE
error := "receive data failed"
END;
RETURN FALSE
END ReceiveData;
BEGIN
timeout := 5000;
i := 0; REPEAT W.Char(C); W.Update(); INC(i) UNTIL Read(ch) OR (i > 10);
IF ch # 0X THEN error := "" END; len := MAX(LONGINT);
IF F # NIL THEN
Files.OpenWriter(fW, F, 0)
ELSIF mode # YModem THEN
error := "invalid file handle"; RETURN
ELSE
fW := NIL
END;
timeout := 10000;
fail := FALSE; i := 1;
WHILE ~fail & ((ch = SOH) OR (ch = STX)) DO
IF ch = SOH THEN blkn := 128 ELSIF ch = STX THEN blkn := 1024 END;
IF Read(ch) & Read(ch2) THEN
IF (i = ORD(ch)) & (ORD(ch) = (255-ORD(ch2))) THEN
IF fW = NIL THEN
W.Char(CAN); W.Update();
error := "invalid file handle"; RETURN
END;
IF ReceiveData() THEN
IF len < blkn THEN blkn := len END;
fW.Bytes(data, 0, blkn); DEC(len, blkn);
INC(bytesProcessed, blkn);
END
ELSIF (i = 1) & (ch = 0X) & (ch2 = 0FFX) & (mode = YModem) THEN
IF ReceiveData() THEN
YHeader(blkn, name, len); W.Char(C); W.Update();
IF F = NIL THEN F := Files.New(name); Files.OpenWriter(fW, F, 0) END
END;
i := 1
ELSE
fail := TRUE; error := "wrong block number"
END;
IF ~fail THEN fail := ~Read(ch) END
ELSE
fail := TRUE
END
END;
IF ~fail & ((ch = EOT) OR (ch = CAN)) THEN
IF ch = EOT THEN
IF mode = YModem THEN
W.Char(NAK); W.Update();
IF Read(ch) & (ch = EOT) THEN
W.Char(ACK); W.Char(C); W.Update();
IF Read(ch) & (ch = SOH) THEN
IF Read(ch) & Read(ch2) THEN
ASSERT((ch = 0X) & (ch2 = 0FFX));
blkn := 128; fail := ~ReceiveData();
ASSERT(data[0] = 0X)
END
END
END
ELSE
W.Char(ACK); W.Update()
END;
error := ""; fW.Update()
ELSE
W.Char(ACK); W.Update();
error := "transfer aborted"
END
ELSE
W.Char(CAN); W.Update();
IF error = "" THEN error := "wrong block header" END
END
END ReceiveFile;
BEGIN {ACTIVE}
ReceiveFile(); Stop()
END Receiver;
PROCEDURE IsDigit(ch: CHAR): BOOLEAN;
BEGIN
RETURN (ch >= "0") & (ch <= "9")
END IsDigit;
PROCEDURE CRC16(VAR buf: ARRAY OF CHAR; len: LONGINT): LONGINT;
VAR i, k, crc: LONGINT;
BEGIN
crc := 0; i := 0;
WHILE i < len DO
crc := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, crc) / SYSTEM.VAL(SET, LONG(ORD(buf[i]))*LONG(100H)));
k := 0;
WHILE k < 8 DO
IF (15 IN SYSTEM.VAL(SET, crc)) THEN
crc := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, crc*2) / SYSTEM.VAL(SET, 1021H))
ELSE
crc := crc*2
END;
INC(k)
END;
INC(i)
END;
RETURN crc MOD 10000H
END CRC16;
PROCEDURE GetPars(context :Commands.Context; VAR name: ARRAY OF CHAR; VAR port, bps, parity, stop: LONGINT): BOOLEAN;
BEGIN
port := 0; bps := 115200; parity := Serials.ParNo; stop := Serials.Stop1;
IF context.arg.GetString(name) & IsDigit(name[0]) THEN
Strings.StrToInt(name, port);
context.arg.SkipWhitespace; context.arg.Int(bps, FALSE);
context.arg.SkipWhitespace; context.arg.String(name);
IF name = "odd" THEN
parity := Serials.ParOdd
ELSIF name = "even" THEN
parity := Serials.ParEven
ELSIF name = "mark" THEN
parity := Serials.ParMark
ELSIF name = "space" THEN
parity := Serials.ParSpace
ELSIF name # "no" THEN
context.error.String("wrong parity"); context.error.Ln();
RETURN FALSE
END;
context.arg.SkipWhitespace; context.arg.String(name);
IF name = "1.5" THEN
stop := Serials.Stop1dot5
ELSIF name = "2" THEN
stop := Serials.Stop2
ELSIF name # "1" THEN
context.error.String("wrong stop bits"); context.error.Ln();
RETURN FALSE
END;
context.arg.SkipWhitespace; context.arg.String(name);
END;
RETURN TRUE
END GetPars;
PROCEDURE xySend(context : Commands.Context; mode: LONGINT);
VAR
name: Files.FileName; F: Files.File;
port: Serials.Port; portn, bps, parity, stop, res: LONGINT;
send: Sender; error: ARRAY 64 OF CHAR;
W: Streams.Writer; R: Streams.Reader;
BEGIN
IF GetPars(context, name, portn, bps, parity, stop) THEN
context.out.String(name); context.out.Ln;
F := Files.Old(name);
port := Serials.GetPort(portn);
ASSERT(port # NIL);
port.Open(bps, 8, parity, stop, res);
ASSERT(res = Serials.Ok);
Streams.OpenWriter(W, port.Send); Streams.OpenReader(R, port.Receive);
NEW(send, W, R, F, mode);
send.Await(error);
port.Close();
IF error # "" THEN
context.error.String(" "); context.error.String(error);
ELSE
context.out.String(" done");
END;
context.out.Ln;
END;
END xySend;
PROCEDURE XSend*(context : Commands.Context);
BEGIN
context.out.String("XSend ");
xySend(context, XModem)
END XSend;
PROCEDURE XSend1K*(context : Commands.Context);
BEGIN
context.out.String("XSend1K ");
xySend(context, XModem1K)
END XSend1K;
PROCEDURE YSend*(context : Commands.Context);
BEGIN
context.out.String("YSend ");
xySend(context, YModem)
END YSend;
PROCEDURE xyReceive(context : Commands.Context; mode: LONGINT);
VAR
name: Files.FileName; F: Files.File;
port: Serials.Port; portn, bps, parity, stop, res: LONGINT;
recv: Receiver; error: ARRAY 64 OF CHAR; awaitF: BOOLEAN;
W: Streams.Writer; R: Streams.Reader;
BEGIN
IF GetPars(context, name, portn, bps, parity, stop) THEN
context.out.String(name); context.out.Ln();
IF name # "" THEN
F := Files.New(name); awaitF := FALSE
ELSE
ASSERT(mode = YModem);
F := NIL; awaitF := TRUE
END;
port := Serials.GetPort(portn);
ASSERT(port # NIL);
port.Open(bps, 8, parity, stop, res);
ASSERT(res = Serials.Ok);
Streams.OpenWriter(W, port.Send); Streams.OpenReader(R, port.Receive);
NEW(recv, W, R, F, mode);
IF ~awaitF THEN
recv.Await(error)
ELSE
recv.AwaitF(F, error)
END;
port.Close();
IF error # "" THEN
context.error.String(" "); context.error.String(error);
ELSE
Files.Register(F);
IF awaitF THEN
F.GetName(name);
context.out.String(" "); context.out.String(name);
END;
context.out.String(" done");
END;
context.out.Ln;
END;
END xyReceive;
PROCEDURE XReceive*(context : Commands.Context);
BEGIN
context.out.String("XReceive ");
xyReceive(context, XModem)
END XReceive;
PROCEDURE YReceive*(context : Commands.Context);
BEGIN
context.out.String("YReceive ");
xyReceive(context, YModem)
END YReceive;
END XYModem.
Aos.Call XYModem.YSend 0 115200 no 1 test.dat ~
Aos.Call XYModem.YReceive 0 115200 no 1 test.dat ~
SystemTools.Free XYModem ~