Oberon/ETH Oberon/PPPHDLC.Mod
< Oberon | ETH Oberon
(* ETH Oberon, Copyright 1990-2003 Computer Systems Institute, ETH Zurich, CH-8092 Zurich.
Refer to the license.txt file provided with this distribution. *)
(* $VCS 1, Edgar.Schwarz@z.zgs.de, 28 Feb 99, 22:13:54 $ *)
MODULE PPPHDLC; (** non-portable *)
(* $Log$
$ 1, Edgar.Schwarz@z.zgs.de, 28 Feb 99, 22:13:54
version for PPP 1.0.0
*)
IMPORT
Debug := PPPDebug, SYSTEM, T:=PPPTools,
(*es*) Oberon, Ker:=Kernel, V24, PT := NetBase, Input, Out, Strings;
(* Ker:=PPCXOKernel, P:=Peripherals; *)
CONST
HDLCAddress=0FFX;
HDLCControl=03X;
HDLCHeaderLen* = 4; (* Flag + Address, Protocol (2 Byte) *)
EscSymbol = 7DX;
FlagSymbol = 7EX;
MTU*=1500;
StartPos*=4; (* even if we received a packed Packet, we can send back an unpacked one, using the same array *)
ArrayLength* = MTU+100; (* some bytes more needed *)
TYPE
Params* = POINTER TO ParamsDesc;
ParamsDesc* = RECORD END;
CallbackProc*=PROCEDURE (p:Params);
TimeOut = POINTER TO TimeOutDesc;
TimeOutDesc = RECORD
time: LONGINT;
callback: CallbackProc; params: Params;
next: TimeOut;
END;
PPPUnit* = POINTER TO PPPUnitDesc;
MyTask* = POINTER TO MyTaskDesc;
MyTaskDesc = RECORD
(*es*) (Oberon.TaskDesc)
(* (Ker.MainEventDesc) (* Oberon.TaskDesc *) *)
Config*:PPPUnit;
END;
PPPUnitDesc* = RECORD
MTU*, MRU*:INTEGER; (* Maximum Transmit Unit, how big our packets are; M Receive U, how big he may send*)
SendAsyncMap*:SET; (* Transmit AsyncMap; What characters have to be stuffed *)
(*es*) c*: LONGINT;
(* c*: P.SerialChannel; *)
cname*:ARRAY 32 OF CHAR;
task*: MyTask;
data, data2*: ARRAY ArrayLength OF CHAR;
TOqueue: TimeOut;
TOempty: BOOLEAN;
END;
VAR
(*es*)
debug*: BOOLEAN;
TOtask: Oberon.Task; (* check for timeout *)
TOunit: PPPUnit; (* instead of extending task *)
(*TOrecycle: TimeOut;*)
FrameCount: INTEGER; (* pe: number frames for reference. *)
(*es*) (* Save incomplete frames between calls to Receive *)
receiveFrame: RECORD
active: BOOLEAN; (* ready to receive data *)
(*deadline: LONGINT; (* until we want to receive the end *)*)
i: INTEGER; (* index of last received byte in receive buffer *)
esc: BOOLEAN; (* last byte received was EscSymbol *)
END;
(**)PPPHandleReceive*:
PROCEDURE (U:PPPUnit; prot:INTEGER; VAR p: ARRAY OF CHAR;
pos, len:INTEGER; VAR prno: INTEGER; VAR item: PT.Item);
PROCEDURE SendString(c: (*es*)LONGINT(*P.SerialChannel*);
VAR s: ARRAY OF CHAR);
VAR l0, l1, start: LONGINT;
(*es*)res: LONGINT;(**)
BEGIN
l0 := 0; WHILE s[l0] # 0X DO INC(l0) END; l1 := l0; start := 0;
(*es*) WHILE l0 > 0 DO
V24.SendBytes(c, s, l1, res);
DEC(l0, l1);
END
(* WHILE l0 > 0 DO
c.Write(s, start, l1);
DEC(l0, l1); INC(start, l1)
END *)
END SendString;
(* Init *)
PROCEDURE Init* (Config:PPPUnit;
c:(*es*)LONGINT(* P.SerialChannel*);
VAR cname, sstr, loginname, loginpasswd: ARRAY OF CHAR);
VAR to:TimeOut; l: LONGINT; temp: ARRAY 4 OF CHAR;
cr: ARRAY 2 OF CHAR;
(*es*)res: LONGINT;(**)
BEGIN
Config.c := c; COPY(cname, Config.cname);
(*es??? die V24 und Loginsachen macht doch der Dialer. Oder ?
(* V24 login is handled by the Dialer, isn't it? *)
WHILE V24.Available(c) > 0 DO V24.Receive(c, temp[0],res); END;
(* WHILE c.Available > 0 DO l := 1; c.Read(temp, 0, l) END; *)
(* send start string *)
IF sstr[0] # 0X THEN
SendString(c, sstr);
(* consume some bytes (they contain the reply string from server) *)
REPEAT
WHILE c.Available > 0 DO l := 1; c.Read(temp, 0, l) END;
Ker.Sleep(1, Ker.ONEsec)
UNTIL c.Available = 0
END;
IF loginname[0] # 0X THEN (* start normal unix-login procedure *)
cr[0] := 0DX; cr[1] := 0X;
(* send two CR *)
SendString(c, cr); Ker.Sleep(1, Ker.ONEsec);
SendString(c, cr); Ker.Sleep(5,Ker.ONEsec);
(* send loginname *)
SendString(c, loginname); SendString(c, cr);
Ker.Sleep(1, Ker.ONEsec);
(* send loginpasswd *)
SendString(c, loginpasswd); SendString(c, cr);
Ker.Sleep(1, Ker.ONEsec);
END;
REPEAT
WHILE c.Available > 0 DO
l := 1; c.Read(temp, 0, l);
Debug.Int(ORD(temp[0]),4);
IF (temp[0] >= 20X) & (temp[0] <= 7FX) THEN
Debug.Char(9X); Debug.Char(temp[0])
END;
Debug.Ln;
END;
Ker.Sleep(5,Ker.ONEsec);
Debug.Ln;
UNTIL c.Available = 0;
es*)
Debug.String("Starting receiving-loop"); Debug.Ln;
NEW(Config.task); Config.task.Config:=Config;
(*es???*) Debug.String("Pustekuchen, macht Devicepolling"); Debug.Ln;
(* pe *) Debug.String("Begin communicating with the remote system."); Debug.Ln;
Debug.String("Configure the timeout."); Debug.Ln;
(*Ker.InitMain(Config.task);*)
NEW(to); Config.TOqueue:=to; to.next:=to;
to.time:=MAX(LONGINT); Config.TOempty:=TRUE; (* sentinel *)
END Init;
PROCEDURE CheckTimer((*es*)me: Oberon.Task(*C: PPPUnit*));
(* Called only when TOqueue is not empty *)
VAR cur:TimeOut;
BEGIN
cur:=(*es*)TOunit(*C*).TOqueue;
IF cur.time < (*es*)Input.Time()(*Ker.Time()*) THEN
(*es*) Oberon.Remove(me);
IF TOunit.cname # "" THEN
(* output only if ppp is still running. See PPPMain.StopInst *)
Out.String("PPP timeout"); Out.Ln;
END;
(**)
(*es*)TOunit(*C*).TOempty:=TRUE;
cur.callback(cur.params);
END
END CheckTimer;
(* TimeOut Handling *)
PROCEDURE TIMEOUT* (C: PPPUnit; callb:CallbackProc; p:Params;
msec:LONGINT); (* msec: in microS-sec *)
VAR cur:TimeOut;
BEGIN
cur:=C.TOqueue; cur.callback:=callb; cur.params:=p;
cur.time:=(*es*) Input.Time(*Ker.Time*)()+msec;
C.TOempty:=FALSE;
(*es install timer task *)
TOtask.safe := FALSE; TOtask.time := 0;
TOtask.handle := CheckTimer;
Oberon.Install(TOtask);
TOunit := C;
(**)
END TIMEOUT;
PROCEDURE UNTIMEOUT* (C: PPPUnit; callb:CallbackProc);
BEGIN
C.TOempty:=TRUE;
(*es*) Oberon.Remove(TOtask); (**)
END UNTIMEOUT;
(* CheckPacket - Check a HDLC-Packet *)
PROCEDURE CheckPacket(Config: PPPUnit; VAR p: ARRAY OF CHAR;
pos, len:INTEGER; VAR prno: INTEGER; VAR item: PT.Item);
(*es*)VAR timeStr: ARRAY 16 OF CHAR; time, date: LONGINT;(**)
BEGIN
IF debug THEN
(* pe *) Debug.String('->->-> Frame '); Debug.Int(FrameCount, 5);
Debug.String(' received from peer.'); Debug.Ln;
INC(FrameCount); (* pe *)
Oberon.GetClock(time, date);
Strings.TimeToStr(time,timeStr);
Debug.String(timeStr);
Debug.String('CheckPacket: len = '); Debug.Int(len, 5); Debug.Ln;
T.OutPacket(p, pos, len);
END;
IF len > HDLCHeaderLen+2 THEN
(*[HDLC_Address+HDLC-Control+Protocol] + Checksum (2 Bytes)*)
IF T.CheckFCS(p, pos, len) THEN
(* CheckSum ok? The whole packet needed! *)
IF (p[pos] = HDLCAddress) & (p[pos+1] = HDLCControl) THEN
PPPHandleReceive(Config, T.GetInt(p, pos+2), p, pos+4, len-6,
prno, item);
ELSE (* silently discarded *)
IF debug THEN
Debug.String("Address, Code wrong"); Debug.Ln;
END;
END
ELSE
IF debug THEN Debug.String("Checksum failure"); Debug.Ln END
END
ELSE
IF debug & (len > 0) THEN
Debug.String("Length too short, length: ");
Debug.Int(len, 6); Debug.Ln;
END;
END
END CheckPacket;
PROCEDURE XOR20(ch:LONGINT):LONGINT;
BEGIN RETURN SYSTEM.VAL(LONGINT, (SYSTEM.VAL(SET, ch) / {5} ));
END XOR20;
(* ReceivePacket - ReceiveLoop: Task , needs extended Event
(including PPPUnit)*)
(*es*) (* ReceivePacket is indirectly called by NetBase.Polldevices when
characters at the serial interface are available. So just read the characters
into a buffer (Config.data) and return prno=0 (no handler installed for this
protocol hopefully). When you get end of frame (FlagSymbol) then check
it and return the stuff. *)
(**)PROCEDURE ReceivePacket*(Config: PPPUnit; VAR prno: INTEGER;
VAR item: PT.Item);
VAR (*es*) (*i:INTEGER;*)
ch: ARRAY 4 OF CHAR; l: LONGINT;
(*es*)c, res, endTime: LONGINT; timeOut : TimeOut;
(* c: P.SerialChannel; *)
BEGIN
c:=Config.c;
(*es*)(* i:=StartPos; ch[0]:=0X; (* not Esc-Symbol *) *)
(*es*)IF receiveFrame.active THEN
prno := 0;
ELSE
(*receiveFrame.deadline := Input.Time() + 10(*s*) * Input.TimeUnit;*)
receiveFrame.i := StartPos;
receiveFrame.active := TRUE;
receiveFrame.esc := FALSE;
ch[0]:=0X;
END;
IF receiveFrame.esc THEN ch[0] := EscSymbol ELSE ch[0]:=0X; END;
(**) LOOP
IF (*es*)V24.Available(c)(*c.Available*)>0 THEN
(* New chars in buffer ? *)
IF ch[0] (* last received *) #EscSymbol THEN
(*es*) V24.Receive(c, ch[0], res);
(*l := 1; c.Read(ch, 0, l);*)
IF ch[0] = FlagSymbol THEN (* end of frame received *)
CheckPacket(Config, Config.data, StartPos,
receiveFrame.i-StartPos, prno, item);
(*es*) (* data now in item *) receiveFrame.active := FALSE; RETURN;
(* receiveFrame.i:=StartPos; *)
ELSE
IF ch[0] # EscSymbol THEN
Config.data[receiveFrame.i]:=ch[0];
INC(receiveFrame.i) ;
(*es*) receiveFrame.esc := FALSE;
ELSE
receiveFrame.esc := TRUE;
(**) END
END;
ELSE
(*es*) V24.Receive(c, ch[0], res); receiveFrame.esc := FALSE;
(*l := 1; c.Read(ch, 0, l);*)
Config.data[receiveFrame.i]:=CHR(XOR20(ORD(ch[0])));
INC(receiveFrame.i); ch[0]:=0X; (* not Esc-,or Flag-Symbol *)
END;
IF receiveFrame.i>=ArrayLength THEN
Debug.String("Array Overflow!!");
(*HALT(99);*)
receiveFrame.active := FALSE; RETURN
END;
ELSE
RETURN; (* pause until more characters are available *)
(**)
END;
END
END ReceivePacket;
(* SendPacket - Send a packet to the V24 *)
PROCEDURE SendPacket* (Config: PPPUnit; prot:INTEGER;
VAR p:ARRAY OF CHAR; pos, len:INTEGER);
VAR minpos, code, k, begin: INTEGER; ch: ARRAY 4 OF CHAR; l0, l1, start: LONGINT; x: CHAR;
(*es*)c, res: LONGINT;
timeStr: ARRAY 16 OF CHAR; time, date: LONGINT;
(*c: P.SerialChannel;*)
BEGIN
c:=Config.c;
minpos:=HDLCHeaderLen;
IF pos<minpos THEN T.CopyString(p, pos, minpos, len); pos:=minpos; END; (* More space needed *)
DEC(pos, HDLCHeaderLen); INC(len, HDLCHeaderLen);
p[pos]:=0FFX; p[pos+1]:=03X; (* pos + 0: HDLC_Address = 0FFX; pos + 1: HDLC_Control =3X *)
T.PutInt(prot, p, pos+2); (* pos + 2: Protocol *)
code:=T.CalcFCS(p, pos, len);
p[pos+len]:=CHR(code MOD 256);
p[pos+len+1]:=CHR(SYSTEM.LSH(code, -8)); INC(len, 2);
(* insert the checksum *)
IF debug THEN
(* pe *) Debug.String('<-<-<- Frame '); Debug.Int(FrameCount, 5);
Debug.String(' going to peer.'); Debug.Ln;
INC(FrameCount); (* pe *)
Oberon.GetClock(time, date);
Strings.TimeToStr(time,timeStr);
Debug.String(timeStr);
Debug.String(' SendPacket: len = '); Debug.Int(len, 5); Debug.Ln;
T.OutPacket(p, pos, len); Debug.Ln
END;
(* send it to the V24 *)
ch[0]:=FlagSymbol;
l0 := 1; l1 := l0; start := 0;
WHILE l0 > 0 DO
(*es*)V24.Send(c,ch[start], res);
(* c.Write(ch, start, l1); *)
DEC(l0, l1); INC(start, l1)
END;
(* es auskommentiert: der Trick ist irgendwie alle Zeichen zu sammeln,
die man ohne Maskierung (EscSymbol) senden kann. Wenn man dann
auf eines trifft, verpackt man es und schickt die Dinger von zuvor
auf weg. Das ist mir etwas zu undurchsichtig.
Translation & remark from T.F.
Section commented out: The trick is to somehow collect all the
characters that can be sent without escaping (EscSymbol). Once we
come across a character that needs escaping, we send all the previously
collected characters followed by the escaped character.
It is probably some kind of "optimized code" that was translated and when
it did not work was finally replaced by the version below the
commented-out code. From what I can tell the active code is better
anyways (simpler). If optimization is needed, AosIO could be used to collect
the characters in a much simpler way. *)
(* begin:=pos;
FOR k:=pos TO pos+len-1 DO x:=p[k];
IF ((ORD(x)<20H) & (ORD(x) IN Config.SendAsyncMap))
OR (x=EscSymbol) OR (x=FlagSymbol) THEN
l0 :=k-begin; l1 := l0; start := begin;
WHILE l0 > 0 DO c.Write(p, start, l1); DEC(l0,l1); INC(start,l1);END;
begin:=k+1;
ch[0]:=EscSymbol; ch[1]:=CHR(XOR20(ORD(x)));
l0 := 2; l1 := l0; start := 0;
WHILE l0 > 0 DO c.Write(ch, start, l1); DEC(l0,l1); INC(start,l1);END;
END;
END;
p[pos+len]:=FlagSymbol; l0 := pos+len+1-begin; l1 := l0; start := begin;
WHILE l0 > 0 DO c.Write(p, start, l1); DEC(l0, l1); INC(start, l1); END;
*)
(*es*)
FOR k:=pos TO pos+len-1 DO
x:=p[k];
IF ((ORD(x)<20H) & (ORD(x) IN Config.SendAsyncMap))
OR (x=EscSymbol) OR (x=FlagSymbol) THEN
V24.Send(c,EscSymbol, res);
IF res # 0 THEN HALT(99); END;
V24.Send(c,CHR(XOR20(ORD(x))), res);
IF res # 0 THEN HALT(99); END;
ELSE
V24.Send(c, x, res);
IF res # 0 THEN HALT(99); END;
END;
END;
(* frame complete: send end flag *)
V24.Send(c,FlagSymbol, res);
IF res # 0 THEN HALT(99); END;
(**)
END SendPacket;
BEGIN
(* pe *) FrameCount := 0;
debug := FALSE;
(*es*) receiveFrame.active := FALSE;
NEW(TOtask);
(*NEW(TOrecycle); TOrecycle.next:=TOrecycle; (* Sentinel *)*)
END PPPHDLC.