🚀 go-pugleaf

In article <1992Apr6.134601.7265@waikato.ac.nz> slang@waikato.ac.nz writes:
>Has anyone got a Modula-2 Interface for Packet Drivers???
>
>Just thought I'd ask, before I got any further in writing one.
>
This is a straightforward one implemented in TopSpeed Modula-2.
Sorry, it is written in spanish.

-----------------------------------------------------------------

DEFINITION MODULE Eth;
(* Manejador de Ethernet con demultiplexion por tipo de protocolo.
   Cada proceso puede asociarse varios tipos de protocolo. *)

TYPE TDir = ARRAY [0..5] OF SHORTCARD;

PROCEDURE MiraDir (VAR dir : TDir); (* Mira direccion cableada *)

CONST
  DatMin =   46;                (* numero de bytes minimo por paquete *)
  DatMax = 1500;                (* numero de bytes maximo por paquete *)
  LCab   =   14;                (* cabecera del paquete *)
  LPaqMin= LCab + DatMin;       (* paquete minimo *)
  LPaqMax= LCab + DatMax;       (* paquete maximo *)

TYPE
  TTipo   = ARRAY [0..1] OF SHORTCARD;  (* tipo de protocolo *)
  RPaquete = [LPaqMin..LPaqMax];
  TPaqMin  = RECORD                     (* paquete minimo *)
               destino : TDir;
               origen  : TDir;
               tipo    : TTipo;
               datos   : ARRAY [0..DatMin-1] OF SHORTCARD;
             END;
  TPaqMax  = RECORD                     (* paquete maximo *)
               destino : TDir;
               origen  : TDir;
               tipo    : TTipo;
               datos   : ARRAY [0..DatMax-1] OF SHORTCARD;
             END;

PROCEDURE Envia (VAR paq : ARRAY OF BYTE; long : RPaquete);
  (* Envia un paquete Ethernet "paq" de "long" bytes *)

PROCEDURE Filtra(proto: TTipo);
  (* Selecciona un protocolo para este proceso *)

PROCEDURE Hay(): BOOLEAN;
  (* Determina si hay paquetes del tipo seleccionado pendientes por recoger *)

PROCEDURE Recibe (VAR paq : ARRAY OF BYTE; VAR long : RPaquete);
  (* Recibe un paquete del tipo seleccionado en "paq", obteniendo la 
     longitud en "long". Si no hay nada, espera *)

PROCEDURE ActivaPromiscuo (sn : BOOLEAN);
   (* Activa o inhibe el modo de lectura promiscuo
      sn = TRUE  -> promiscuo si
      sn = FALSE -> promiscuo no *)

END Eth.

-----------------------------------------------------------------

IMPLEMENTATION MODULE Eth;

FROM SYSTEM IMPORT Registers, CarryFlag, Seg, Ofs, InterruptRegisters,
                   ADR, ADDRESS, PROCESS, NEWPROCESS, TRANSFER, IOTRANSFER,
                   CurrentProcess, Listen, In, Out;
FROM Lib IMPORT Intr, Terminate;
FROM Storage IMPORT ALLOCATE;
IMPORT Colas;

CONST PDIVector= 69H; RecVector= PDIVector+1;
      TCola= 10000;

TYPE PProto= POINTER TO Proto;
     Proto= RECORD
              cor: PROCESS;
              han: CARDINAL;
              col: Colas.cola;
              sig: PProto;
            END;

VAR Class, Type, Number: CARDINAL;
    protos: PProto;
    RecMachine: ARRAY[0..2] OF SHORTCARD;
    TRec: ARRAY[0..SIZE(TPaqMax)+1000] OF BYTE;
    PRec, Princ: PROCESS;
    R:    Registers;
    IReg: POINTER TO Registers;
    Fin: PROC;

PROCEDURE MiProto(): PProto;
  VAR yo: PROCESS; p: PProto;
BEGIN
  yo:= CurrentProcess(); p:= protos;
  WHILE (p # NIL) & (p^.cor # yo) DO p:= p^.sig END;
  IF p = NIL THEN HALT END;
  RETURN p
END MiProto;

PROCEDURE MiraDir(VAR d: TDir);
  VAR R: Registers; p: PProto;
BEGIN
  WITH R DO
    AH:= 6;
    ES:= Seg(d); DI:= Ofs(d); CX:= SIZE(TDir);
    p:= MiProto();
    BX:= p^.han;
    Intr(R, PDIVector);
    IF CarryFlag IN Flags THEN HALT END;
  END
END MiraDir;

PROCEDURE Envia (VAR paq : ARRAY OF BYTE; long : RPaquete);
  VAR R: Registers;
BEGIN
  WITH R DO
    AH:= 4;
    DS:= Seg(paq); SI:= Ofs(paq);
    CX:= long;
    Intr(R, PDIVector);
    IF CarryFlag IN Flags THEN HALT END;
  END
END Envia;

PROCEDURE Filtra(proto: TTipo);
  VAR Receiver: PROC;
      R: Registers;
      p, q: PProto;
      ok: BOOLEAN;
BEGIN
  WITH R DO
    AH:= 2;
    AL:= SHORTCARD(CHR(Class));
    BX:= Type;
    DL:= SHORTCARD(CHR(Number));
    DS:= Seg(proto); SI:= Ofs(proto); CX:= SIZE(proto);
    ES:= Seg(RecMachine); DI:= Ofs(RecMachine);
    Intr(R, PDIVector);
    IF CarryFlag IN Flags THEN HALT END;
    NEW(p);
    WITH p^ DO han:= AX; cor:= CurrentProcess(); sig:= protos END;
    q:= protos;
    protos:= p;
    WHILE (q # NIL) & (q^.cor # CurrentProcess()) DO q:= q^.sig END;
    IF q # NIL THEN
       protos^.col:= q^.col
    ELSE
       Colas.Crea(protos^.col, TCola, ok);
       IF NOT ok THEN HALT END;
    END;
  END;
END Filtra;

PROCEDURE Hay(): BOOLEAN;
  VAR p: PProto;
BEGIN
  p:= MiProto();
  RETURN Colas.Hay(p^.col);
END Hay;

PROCEDURE Recibe (VAR paq : ARRAY OF BYTE; VAR long : RPaquete);
  VAR c: Colas.cola; sacado: BOOLEAN; l: CARDINAL; p: PProto;
BEGIN
  p:= MiProto(); c:= p^.col;
  WHILE NOT Colas.Hay(c) DO Listen({0..15}) END;
  Colas.Saca(c, paq, l, sacado);  long:= l;
END Recibe;

PROCEDURE ActivaPromiscuo (sn: BOOLEAN);
  VAR R: Registers; p: PProto;
BEGIN
  WITH R DO
    AH:= 20;
    IF sn THEN CX:= 6 ELSE CX:= 2 END;
    p:= MiProto();
    BX:= p^.han;
    Intr(R, PDIVector);
    IF CarryFlag IN Flags THEN HALT END;
  END
END ActivaPromiscuo;

PROCEDURE Receptor;
  VAR temp: TPaqMax; p: PProto; long: CARDINAL; ok: BOOLEAN;
BEGIN
  LOOP
    IOTRANSFER(PRec, Princ, RecVector);
    IReg:= InterruptRegisters(Princ);
    WITH IReg^ DO
     IF AX=0 THEN
       p:= protos;
       WHILE (p # NIL) & (p^.han # BX) DO p:= p^.sig END;
       IF p = NIL THEN HALT END;
       long:= CX;
       DS:= Seg(temp); DI:= Ofs(temp);
     ELSIF AX=1 THEN
       IF (BX # p^.han) OR (long # CX) THEN HALT END;
       Colas.Mete(p^.col, temp, long, ok);
     ELSE HALT
     END
    END
  END
END Receptor;

PROCEDURE Libera; 
  VAR R: Registers;
BEGIN
  WITH R DO
    WHILE protos # NIL DO
      AH:= 20; CX:= 2; BX:= protos^.han; Intr(R, PDIVector); (* no promiscuo *)
      AH:= 3; BX:= protos^.han; Intr(R, PDIVector); (* libre *)
      protos:= protos^.sig;
    END;
  END;
  Fin();
END Libera;

BEGIN
  WITH R DO (* Obtiene informacion *)
    AH:=1; AL:= 0FFH; BX:= 1;
    Intr(R, PDIVector);
    IF CarryFlag IN Flags THEN HALT END;
    Class:= ORD(CH);
    Type:=  DX;
    Number:=ORD(CL);
  END;
  protos:= NIL;
  Terminate(Libera, Fin);
  RecMachine[0]:= 0CDH; (* INT opcode *)
  RecMachine[1]:= RecVector;
  RecMachine[2]:= 0CBH; (* RETF opcode *)
  NEWPROCESS(Receptor, ADR(TRec), SIZE(TRec), PRec);
  TRANSFER(Princ, PRec);
END Eth.

-----------------------------------------------------------------


Joaquin Seoane Pascual       tel: +34 1 3367349
                             or:  +34 1 5495700, +34 1 5495762 (x.468)
Dpt. Ing. Telematica                 
E.T.S.I. Telecomunicacion            
Ciudad Universitaria         fax: +34 1 3367333 or 5432077
E-28040  MADRID              tlx: 47430 ETSIT E
SPAIN

E-mail:        jseoane@dit.upm.es
Alternatives:  jseoane@goya.uucp
               jseoane%dit.upm.es@uunet.uu.net