home *** CD-ROM | disk | FTP | other *** search
/ Computer Club Elmshorn Atari PD / CCE_PD.iso / pc / 0500 / CCE_0544.ZIP / CCE_0544 / MX2 / MX2SRC.ARC / NETWORK.MOD < prev    next >
Text File  |  1989-01-05  |  28KB  |  853 lines
  1.  
  2. (*              Copyright 1987 fred brooks LogicTek             *)
  3. (*                                                              *)
  4. (*                                                              *)
  5. (*   First Release                      12/8/87-FGB             *)
  6. (*                                                              *)
  7.  
  8. IMPLEMENTATION MODULE NETWORK ;
  9.  
  10. (* --------------------------------------------------------------------------
  11.  
  12.                NETWORK : MIDI PORT TWO CPU NETWORK FOR TDI Modula-2/ST
  13.  
  14.    --------------------------------------------------------------------------*)
  15.  
  16. (*$T-,$S-,$A+ *)
  17.  
  18. FROM SYSTEM IMPORT ADDRESS, ADR, SETREG, CODE, REGISTER ,BYTE ,TSIZE;
  19. FROM BIOS   IMPORT BPB ,BConStat ,BConIn, BCosStat, BConOut, Device,
  20.                    MediaChange,MCState,GetBPB,RWAbs,RW,DriveSet,DriveMap;
  21. FROM XBIOS  IMPORT SuperExec,IORec,IORECPTR,IOREC,SerialDevice;
  22. FROM GEMDOS IMPORT TermRes,Open,Close ;
  23. IMPORT             GEMDOS;
  24. FROM ASCII  IMPORT SYN,STX,SOH,BEL;
  25.  
  26. CONST
  27.   MaxSeq          = 1;
  28.   recsize         = 511;
  29.   USER            = 324159265;
  30.   retry           = 10;
  31.   debug           = FALSE;
  32.   trace           = FALSE;
  33.  
  34.   (* Because we dont know what registers the BIOS is using we must use
  35.      the following opcodes to save the registers *)
  36.   MOVEMDEC = 48E7H ;    (* 68000 opcode for MOVEM <regs>,-(A7) *)
  37.   MOVEMINC = 4CDFH ;    (* 68000 opcode for MOVEM (A7)+,<regs> *)
  38.   SAVEREGS = 07FFCH ;   (* Registers D1..A5 for DEC *)
  39.   RESTREGS = 03FFEH ;   (* Registers D1..A5 for INC *)
  40.   RTS = 04E75H ;        (* 68000 return from subroutine opcode *)
  41.  
  42. TYPE
  43.   (* Procedure types to mimic correct sequence for "C" BIOS routines *)
  44.  
  45.   CBPBProc     = PROCEDURE ( CARDINAL ) ;
  46.   CMediaChProc = PROCEDURE ( CARDINAL ) ;
  47.   CRWAbsProc   = PROCEDURE ( CARDINAL, CARDINAL, CARDINAL, ADDRESS, CARDINAL );
  48.   MIDIbuffer   = ARRAY [0..512] OF CARDINAL;
  49.   SequenceNr   = [0..MaxSeq];
  50.   message      = ARRAY [0..recsize] OF BYTE;
  51.   message1     = ARRAY [0..17] OF BYTE;
  52.   FrameKind    = (ack,data,callreq,callaccp,clearreq,clearconf,
  53.                  resetreq,resetconf,diag);
  54.   DataKind     = (rdmediareq,rdmediaconf,rdbpbreq,rdbpbconf,
  55.                  rdrwabsreq,rdrwabsconf);
  56.   evtype       = (framearrival,cksumerr,timeout,hostready,reset,nothing);
  57.  
  58.   frame        = RECORD
  59.                  syn    :       CHAR; (* these are sync chars *)
  60.                  stx    :       CHAR; (* for the frames       *)
  61.                  kind   :       FrameKind;
  62.                  seq    :       SequenceNr;
  63.                  ack    :       SequenceNr;
  64.                  cmd    :       DataKind;
  65.                  rw     :       CARDINAL; (* read or write data *)
  66.                  recno  :       CARDINAL; (* sector for data*)
  67.                  d0     :       LONGCARD; (* data return variable *)
  68.                  info   :       message;
  69.                  user   :       LONGCARD;
  70.                  cksum  :       CARDINAL;
  71.                END;
  72.  
  73.   framecptr    = POINTER TO framecmd;
  74.   framecmd     = RECORD
  75.                  syn    :       CHAR; (* these are sync chars *)
  76.                  stx    :       CHAR; (* for the frames       *)
  77.                  kind   :       FrameKind;
  78.                  seq    :       SequenceNr;
  79.                  ack    :       SequenceNr;
  80.                  cmd    :       DataKind;
  81.                  rw     :       CARDINAL; (* read or write data *)
  82.                  recno  :       CARDINAL; (* sector for data*)
  83.                  d0     :       LONGCARD; (* data return variable *)
  84.                  info   :       message1;
  85.                  user   :       LONGCARD;
  86.                  cksum  :       CARDINAL;
  87.                END;
  88.  
  89.   control     = RECORD
  90.                  magic          :       LONGCARD;
  91.                  reset          :       BOOLEAN;
  92.                  networkactive  :       BOOLEAN;
  93.                  remotedrive    :       CARDINAL;
  94.                  drivemap       :       DriveSet;
  95.                 nextframetosend :      SequenceNr;
  96.                 frameexpected   :      SequenceNr;
  97.                 sendreset       :      BOOLEAN;
  98.                END;
  99.  
  100.   consave     = RECORD
  101.                  magic          :       LONGCARD;
  102.                  reset          :       BOOLEAN;
  103.                  networkactive  :       BOOLEAN;
  104.                 END;
  105.  
  106.   frameptr      =       POINTER TO ARRAY [0..1024] OF BYTE;
  107.  
  108. VAR
  109.  
  110.  
  111.   (* BIOS variables : These can only be accessed with the 68000 in supervisor
  112.      mode. The Modula-2 language allows you to fix the location of variables *)
  113.  
  114.   HDBPB     [0472H] : ADDRESS ;       (* hard disk get Bios Parameter Block *)
  115.   HDRWAbs   [0476H] : ADDRESS ;       (* hard disk read/write abs   *)
  116.   HDMediaCh [047EH] : ADDRESS ;       (* hard disk media change     *)
  117.   DriveBits [04C2H] : SET OF [0..31]; (* disk drives present map    *)
  118.   flock     [043EH] : LONGCARD;       (* disk access in progress    *)
  119.   hz200     [04baH] : LONGCARD;       (* 200hz clock counter        *)
  120.   clock             : LONGCARD;
  121.   Dptr              : DriveSet;       (* save original drive map    *)
  122.   Mptr              : LONGCARD;
  123.   charcount,j,framesize,cksum,recframesize,sndframesize,
  124.   SIZEframe,SIZEframecmd                                : CARDINAL;
  125.  
  126.   networkconnect          :   BOOLEAN; (* DCD = 1 TRUE  *)
  127.   gotframe                :   BOOLEAN;
  128.   framebufferfull         :   BOOLEAN;
  129.   cleartosend             :   BOOLEAN;
  130.   readytosend             :   BOOLEAN;
  131.   requesttosend           :   BOOLEAN;
  132.   framewaiting            :   BOOLEAN;
  133.   timer,OK,installed      :   BOOLEAN;
  134.   gotmediach              :   ARRAY [0..5] OF BOOLEAN;
  135.   gotbpb                  :   ARRAY [0..5] OF BOOLEAN;
  136.   networkerror            :   BOOLEAN;
  137.   shortframe              :   BOOLEAN;
  138.   sendlong                :   BOOLEAN;
  139.  
  140.   sframe,rframe,SFRAME,RFRAME,
  141.   nframe1,nframe2                  :   frame;
  142.   rframeptr,sframeptr,
  143.   bpbptr,nbpbptr                   :   frameptr;
  144.   framecmdptr,framecmdptr1         :   framecptr;
  145.   event                            :   evtype;
  146.   C                                :   control;
  147.   recchar,timestart,timefortimeout,timeouttime :   LONGCARD;
  148.   timestart1,timefortimeout1,timeouttime1      :   LONGCARD;
  149.   result,r,i,i1,i2,i3,mediacount,handle        :   INTEGER;
  150.   D0ptr                                        :   POINTER TO LONGCARD;
  151.   wsector,drvnr,DriveA,DriveF,devicestart,d,R  :   CARDINAL;
  152.   rbuffer                                      :   MIDIbuffer;
  153.   rbptr                                        :   IORECPTR;
  154.   numBytes,sec,min,hour,time,count             :   LONGCARD ;
  155.   status                                       :   LONGINT ;
  156.  
  157.   (* The following are saved copies of the BIOS variables so that the real
  158.      hard disk routines can be called if a hard disk access is requested. *)
  159.  
  160.   SaveHDBPB      : CBPBProc ;     (* hard disk get Bios Parameter Block *)
  161.   SaveHDRWAbs    : CRWAbsProc ;   (* hard disk read/write abs *)
  162.   SaveHDMediaCh  : CMediaChProc ; (* hard disk media change *)
  163.  
  164.   (* NETWORK control *)
  165.  
  166.   NetworkBPB  : ARRAY [0..5] OF BPB ; (* BIOS Parameter block for NETWORK *)
  167.  
  168. PROCEDURE MoveMemory ( From, To : ADDRESS ; Bytes : LONGCARD ) ;
  169. (* This routine shows how time critical portions of code can be optimised to
  170.    run faster. It relys on the code generation rules of the compiler which 
  171.    can be checked by dis-assembling the link file with DecLnk.*)
  172.  
  173. CONST
  174.   MOVEB = 12D8H ;       (*      MOVE.B  (A0)+,(A1)+     *)
  175.   MOVEL = 22D8H ;       (*      MOVE.L  (A0)+,(A1)+     *)
  176.   A0    = 0+8 ;         (* register A0 *)
  177.   A1    = 1+8 ;         (* register A1 *)
  178.  
  179. BEGIN
  180.   SETREG(A0,From) ;             (* load From pointer into A0 *)
  181.   SETREG(A1,To) ;               (* load To pointer into A1 *)
  182.   
  183.   IF ( ODD(From) OR ODD(To) ) THEN      (* must do bytes *)
  184.     WHILE ( Bytes <> 0 ) DO
  185.       CODE(MOVEB) ;
  186.       DEC(Bytes) ;
  187.     END ;
  188.   ELSE (* even addresses so can do long moves *)
  189.     WHILE ( Bytes > 3 ) DO
  190.       CODE(MOVEL) ;
  191.       DEC(Bytes,4) ;
  192.     END ;
  193.     WHILE ( Bytes <> 0 ) DO
  194.       CODE(MOVEB) ;             (* clean up remainder *)
  195.       DEC(Bytes) ;
  196.     END ;
  197.   END ;
  198. END MoveMemory ;
  199.  
  200.  
  201. PROCEDURE inc(VAR k: SequenceNr);   (* increment k circulary *)
  202. BEGIN
  203.         IF k<MaxSeq THEN k:=k+1 ELSE k:=0 END;
  204. END     inc;
  205.  
  206.  
  207. (* The following procedures mimic the disk handling routines called by the
  208.    BIOS. Their procedure declarations have been written to mimic the "C"
  209.    calling sequence. *)
  210.  
  211. PROCEDURE RDRWAbs ( device, RecordNum, SectorCount : CARDINAL ;
  212.                     Buffer : ADDRESS ; Flag : CARDINAL ) ;
  213. (* NB. It is assumed that GEMDOS wont call this routine with out of range
  214.    parameters *)
  215. CONST D0 = 0 ;
  216. BEGIN
  217.   CODE(MOVEMDEC,SAVEREGS) ;     (* save registers on stack *)
  218.   status := 0;
  219.   IF (device >= DriveA) AND (device <=DriveF) THEN (* is NETWORK channel *)
  220.     IF ( Flag = 0 ) OR ( Flag = 2 ) (* read *)  THEN
  221.        FOR wsector:=0 TO (SectorCount-1) DO
  222.            C.remotedrive:=device-devicestart; 
  223.            nframe1.d0:=LONGCARD(device-devicestart);
  224.            nframe1.recno:=RecordNum+wsector;
  225.            nframe1.rw:=Flag; (* read *)
  226.            resetnewdisk;
  227.            IF getfromremote(rdrwabsreq,rdrwabsconf,nframe1) THEN
  228.               MoveMemory(ADR(nframe1.info),Buffer+ADDRESS(wsector)*512,
  229.                          512);
  230.               status:=0;
  231.            ELSE
  232.               status:=(-11);
  233.            END; (* if *)
  234.        END; (* for *)
  235.     IF networkerror THEN C.sendreset:=TRUE END; (* send network reset to remote cpu *)
  236.       SETREG(D0,status) ;
  237.     ELSIF ( Flag = 1 ) OR ( Flag = 3 ) THEN (* write *)
  238.        FOR wsector:=0 TO (SectorCount-1) DO
  239.            C.remotedrive:=device-devicestart; 
  240.            nframe1.d0:=LONGCARD(device-devicestart);
  241.            nframe1.recno:=RecordNum+wsector;
  242.            nframe1.rw:=Flag; (* write *)
  243.            resetnewdisk;
  244.            MoveMemory(Buffer+ADDRESS(wsector)*512,ADR(nframe1.info),512);
  245.            IF getfromremote(rdrwabsreq,rdrwabsconf,nframe1) THEN
  246.               status:=0;
  247.            ELSE
  248.               status:=(-10);
  249.            END;
  250.        END; (* for *)
  251.     IF networkerror THEN C.sendreset:=TRUE END; (* send network reset to remote cpu *)
  252.       SETREG(D0,status) ;
  253.     ELSE
  254.       SETREG(D0,LONGINT(-3)) ;
  255.     END ;
  256.   ELSE (* not NETWORK *)
  257.     SaveHDRWAbs (device,RecordNum,SectorCount,Buffer,Flag) ;
  258.   END ;
  259.   CODE(MOVEMINC,RESTREGS) ;     (* Restore registers from stack *)
  260. END RDRWAbs ;
  261.  
  262. PROCEDURE RDMediaCh ( device : CARDINAL ) ;
  263. CONST D0 = 0 ;
  264. BEGIN
  265.   CODE(MOVEMDEC,SAVEREGS) ;     (* save registers on stack *)
  266.   IF (device >= DriveA) AND (device <=DriveF) THEN (* is NETWORK channel *)
  267.     C.remotedrive:=device-devicestart; 
  268.     nframe1.d0:=LONGCARD(device-devicestart);
  269.     IF newdisk() THEN
  270.        gotmediach[device-devicestart]:=FALSE;
  271.        gotbpb[device-devicestart]:=FALSE;
  272.     END;
  273.     IF (NOT gotmediach[device-devicestart]) THEN
  274.      IF getfromremote(rdmediareq,rdmediaconf,nframe1) THEN 
  275.         gotmediach[device-devicestart]:=TRUE;
  276.         IF nframe1.d0=1 THEN nframe1.d0:=2 END;
  277.         SETREG(D0,nframe1.d0) ;    (* "C" uses D0 as return location *)
  278.      ELSE
  279.         SETREG(D0,Changed);
  280.      END;
  281.     ELSE
  282.        SETREG(D0,NoChange) ;    (* "C" uses D0 as return location *)
  283.     END; 
  284.   ELSE (* not NETWORK *)
  285.     SaveHDMediaCh(device) ;
  286.   END;
  287.   CODE(MOVEMINC,RESTREGS) ;     (* Restore registers from stack *)
  288. END RDMediaCh ;
  289.  
  290. PROCEDURE RDBPB ( device : CARDINAL ) ;
  291. CONST D0 = 0 ;
  292. BEGIN
  293.   CODE(MOVEMDEC,SAVEREGS) ;     (* save registers on stack *)
  294.   IF (device >= DriveA) AND (device <=DriveF) THEN (* is NETWORK channel *)
  295.     C.remotedrive:=device-devicestart; 
  296.     nframe1.d0:=LONGCARD(device-devicestart);
  297.     IF newdisk() THEN gotbpb[device-devicestart]:=FALSE; gotmediach[device-devicestart]:=FALSE END;
  298. (*       gotbpb[device-devicestart]:=FALSE;   (* test *) *)
  299.     IF (NOT gotbpb[device-devicestart]) THEN
  300.      IF getfromremote(rdbpbreq,rdbpbconf,nframe1) THEN 
  301.        gotbpb[device-devicestart]:=TRUE;
  302.        bpbptr:=ADR(nframe1.info);
  303.        nbpbptr:=ADR(NetworkBPB[device-devicestart]);
  304.        FOR i3:=0 TO TSIZE(BPB)-1 DO
  305.            nbpbptr^[i3]:=bpbptr^[i3];    
  306.        END;
  307.        resetnewdisk;
  308.        SETREG(D0,ADR(NetworkBPB[device-devicestart])); (* D0 returns address of the BPB *)
  309.      ELSE
  310.        SETREG(D0,0);
  311.      END;
  312.     ELSE
  313.        SETREG(D0,ADR(NetworkBPB[device-devicestart])); (* D0 returns address of the BPB *)
  314.     END; 
  315.     IF networkerror THEN C.sendreset:=TRUE END; (* send network reset to remote cpu *)
  316.   ELSE (* not NETWORK *)
  317.     SaveHDBPB(device) ;
  318.   END ;
  319.   CODE(MOVEMINC,RESTREGS) ;     (* Restore registers from stack *)
  320. END RDBPB ;
  321.     
  322. PROCEDURE resetnewdisk;
  323. BEGIN
  324.         SuperExec(gettime);
  325.         timestart1:=clock;
  326.         timefortimeout1:=timestart1;
  327.         IncTime(timefortimeout1,2);
  328. END     resetnewdisk;
  329.  
  330. PROCEDURE newdisk(): BOOLEAN;
  331. BEGIN
  332.         SuperExec(gettime);
  333.         timeouttime1:=clock;
  334.         SETREG(0,timeouttime1);
  335.         CODE(0280H,0,0FFFFH);
  336.         timeouttime1:=LONGCARD(REGISTER(0));
  337.         IF timeouttime1>timefortimeout1 THEN
  338.            resetnewdisk;
  339.            RETURN TRUE;
  340.         END;
  341.         RETURN FALSE;
  342. END     newdisk;
  343.  
  344. (* ----------------------------------------------------------------------- *)
  345.  
  346. PROCEDURE Initialise (port: Device) : BOOLEAN ;
  347. (* returns TRUE if NETWORK is to be installed *)
  348. BEGIN
  349.   CODE(3f3cH,0017H,4e4eH,548fH);           (* gettime *)
  350.   CODE(2f00H,3f3cH,0016H,4e4eH,5c8fH);     (* settime *)
  351.   IF NOT installed THEN
  352.     SuperExec(PROC(setcontrol));  (* set address of global control record *)
  353.   END;
  354.   IF port=HSS THEN
  355.     rbptr:=IORec(MIDI);
  356.   ELSE
  357.     rbptr:=IORec(RS232);
  358.   END;
  359.   rbptr^.ibuf:=ADR(rbuffer);
  360.   rbptr^.ibufsize:=1024;
  361.   C.magic:=USER;
  362.   C.remotedrive:=0;
  363.   framesize:=TSIZE(frame);
  364.   recframesize:=framesize;
  365.   sndframesize:=framesize;
  366.   sframe.user:=USER;
  367.   R:=0;
  368.   RETURN TRUE;
  369. END Initialise ;
  370.  
  371. (*$P- *) (* set vector to control record *)
  372. PROCEDURE setcontrol;
  373. BEGIN
  374.         IF Mptr#USER THEN
  375.            C.drivemap:=DriveMap();
  376.            Dptr:=C.drivemap;
  377.         END;
  378.         C.drivemap:=Dptr;
  379.         Mptr:=USER;
  380.         CODE(RTS);
  381. END     setcontrol;
  382.  
  383. PROCEDURE nrecframe; 
  384. BEGIN
  385.         IF C.networkactive THEN
  386.            WHILE (BConStat(netdevice)) AND (NOT framebufferfull) DO
  387.                  recchar := BConIn(netdevice);
  388.                  IF (CHAR(recchar)=SYN) AND (NOT gotframe) THEN
  389.                     gotframe:=TRUE; (* got sync char from data *)
  390.                     charcount:=0;
  391.                  END;
  392.                  IF (charcount=1) AND ((CHAR(recchar)#STX) AND (CHAR(recchar)#SOH)) THEN
  393.                     gotframe:=FALSE; (* false start try again *)
  394.                     charcount:=0;
  395.                  END;
  396.                  IF (charcount=1) AND (CHAR(recchar)=STX) THEN
  397.                     recframesize:=SIZEframe;
  398.                  END;
  399.                  IF (charcount=1) AND (CHAR(recchar)=SOH) THEN
  400.                     recframesize:=SIZEframecmd;
  401.                  END;
  402.                  IF gotframe THEN                  (* put data in buffer *)
  403.                     rframeptr^[charcount]:=BYTE(recchar);
  404.                     INC(charcount);
  405.                     IF charcount=recframesize THEN (* got full frame *)
  406.                        gotframe := FALSE;
  407.         IF trace THEN BConOut(CON,"^") END;
  408.                        IF recframesize=SIZEframecmd THEN
  409.                           rframe.user:=framecmdptr^.user;
  410.                           rframe.cksum:=framecmdptr^.cksum;
  411.                        END;
  412.                        framebufferfull := TRUE;
  413.                     END;
  414.                  END;
  415.            END; (* WHILE *)
  416.         END;
  417. END     nrecframe;
  418.  
  419. (* The following compiler directive stops the compiler from generating the
  420.    normal Modula-2 entry/exit code for the next procedure. This is needed as
  421.    this routine is called in supervisor mode by the BIOS function to install
  422.    the BIOS vectors. *)
  423. (*$P- Stop entry/exit code for next procedure *)
  424. PROCEDURE InstallVectors ;
  425. BEGIN
  426.   (* First save the current hard disk vectors *)
  427.   SaveHDBPB := CBPBProc(HDBPB) ;
  428.   SaveHDRWAbs := CRWAbsProc(HDRWAbs) ;
  429.   SaveHDMediaCh := CMediaChProc(HDMediaCh) ;
  430.   (* Now set the BIOS vectors to our routines *)
  431.   HDBPB := ADDRESS(RDBPB) ;
  432.   HDRWAbs := ADDRESS(RDRWAbs) ;
  433.   HDMediaCh := ADDRESS(RDMediaCh) ;
  434.   drvnr:=2;
  435.   WHILE drvnr IN DriveBits DO
  436.         INC(drvnr);
  437.   END; (* while *)
  438.   INC(drvnr);
  439.   devicestart:=drvnr;
  440.   DriveA:=drvnr;
  441.   DriveF:=drvnr+5;
  442.   INCL(DriveBits,drvnr) ;             (* set new drive A *)
  443.   INCL(DriveBits,drvnr+1) ;           (* set new drive B *)
  444.   INCL(DriveBits,drvnr+2) ;           (* set new drive C *)
  445.   INCL(DriveBits,drvnr+3) ;           (* set new drive D *)
  446.   INCL(DriveBits,drvnr+4) ;           (* set new drive E *)
  447.   INCL(DriveBits,drvnr+5) ;           (* set new drive F *)
  448.   networkconnect := FALSE;
  449.   gotframe := FALSE;
  450.   framebufferfull := FALSE;
  451.   charcount:=0;
  452.   SIZEframe:=TSIZE(frame);
  453.   SIZEframecmd:=TSIZE(framecmd);
  454.  
  455.   rframeptr := ADR(rframe);
  456.   framecmdptr:=ADR(rframe);
  457.   sframeptr := ADR(sframe);
  458.   CODE(RTS) ;                (* code to return to calling BIOS function *)
  459. END InstallVectors ;
  460.  
  461. PROCEDURE waitcts(what: BOOLEAN); (* wait for cleartosend state *)
  462. BEGIN
  463.         IF what THEN
  464.            REPEAT
  465.            nrecframe;
  466.            Nwait(event);
  467.            HandleEvents(); 
  468.            IF R>retry THEN
  469.               networkerror:=TRUE;
  470.               RETURN; (* trouble *)
  471.            END;
  472.            UNTIL cleartosend;
  473.            RETURN;
  474.         ELSE
  475.            LOOP
  476.            nrecframe;
  477.            Nwait(event);
  478.            IF (NOT cleartosend) THEN EXIT END;
  479.            HandleEvents();
  480.            IF R>retry THEN
  481.               networkerror:=TRUE;
  482.               RETURN; (* trouble *)
  483.            END;
  484.            END; (* loop *)
  485.         IF trace THEN BConOut(CON,"N") END;
  486.            HandleEvents(); 
  487.         END;
  488. END     waitcts;
  489.  
  490. (* request for data from remote hosts disk drives and system *)
  491. (* what wanted in command, the correct reply in reply, data in f *)
  492. PROCEDURE getfromremote(command, reply: DataKind; VAR f: frame): BOOLEAN;
  493. BEGIN
  494.         IF (NOT C.networkactive) THEN RETURN FALSE END; (* error *)
  495.         networkerror:=FALSE;
  496.         R:=0;
  497.         StartTimer;
  498.         IF trace THEN BConOut(CON,"A") END;
  499.         f.kind:=data;
  500.         f.cmd:=command;
  501.         waitcts(TRUE);
  502.         IF networkerror THEN RETURN FALSE END;
  503.         IF trace THEN BConOut(CON,"B") END;
  504.         SFRAME:=f;
  505.         requesttosend:=TRUE;
  506.         waitcts(FALSE); 
  507.         IF networkerror THEN RETURN FALSE END;
  508.         IF trace THEN BConOut(CON,"C") END;
  509.         REPEAT  
  510.         nrecframe;
  511.         Nwait(event);
  512.         HandleEvents(); 
  513.         IF R>retry THEN networkerror:=TRUE END;
  514.         IF networkerror THEN RETURN FALSE END;
  515.         UNTIL framewaiting AND (RFRAME.cmd=reply);
  516.         IF trace THEN BConOut(CON,"D") END;
  517.         f:=RFRAME;
  518.         f.rw:=5;
  519.         framewaiting:=FALSE;
  520.         sendtoremote(ack,reply,f); (* send ack for reply *)
  521.         IF networkerror THEN RETURN FALSE END;
  522.         IF trace THEN BConOut(CON,"Z") END;
  523.         RETURN TRUE;
  524. END     getfromremote;
  525.  
  526. PROCEDURE sendtoremote(type: FrameKind; command: DataKind;VAR f: frame);
  527. BEGIN
  528.         IF trace THEN BConOut(CON,"T") END;
  529.         f.kind:=type;
  530.         f.cmd:=command;
  531.         IF debug THEN cleartosend:=TRUE END; (* so we can send in loop *)
  532.         waitcts(TRUE);
  533.         IF trace THEN BConOut(CON,"1") END;
  534.         SFRAME:=f;
  535.         requesttosend:=TRUE;
  536.         waitcts(FALSE);
  537.         IF trace THEN BConOut(CON,"2") END;
  538.         IF SFRAME.kind=ack THEN cleartosend:=TRUE END;
  539. END     sendtoremote;
  540.  
  541. PROCEDURE senddata;
  542. BEGIN
  543.     SFRAME.seq:=C.nextframetosend;
  544.     SFRAME.ack:=1-C.frameexpected;
  545.     sendf(SFRAME);
  546.     IF (SFRAME.kind#ack) AND (SFRAME.kind#resetreq) THEN
  547.        StartTimer; (* set timer to wait for frame ack from remote host *)
  548.     END;
  549. END     senddata;
  550.  
  551. (*$P+ *)
  552. PROCEDURE sendf(VAR f: frame);
  553. BEGIN
  554.         sframe:=f;
  555.         sframe.cksum:=0;
  556.         IF ((sframe.cmd=rdrwabsconf) AND ((sframe.rw=0) OR (sframe.rw=2))) OR ((sframe.cmd=rdrwabsreq) AND ((sframe.rw=1) OR (sframe.rw=3))) THEN
  557.            sndframesize:=SIZEframe;
  558.            sframe.syn :=  SYN ;
  559.            sframe.stx :=  STX ;
  560.            sframe.user := USER ;
  561.            shortframe:=FALSE;
  562.         IF trace THEN BConOut(CON,":") END;
  563.         ELSE
  564.            sndframesize:=SIZEframecmd;
  565.            sframe.syn := SYN ;
  566.            sframe.stx := SOH ;
  567.            framecmdptr1:=ADR(sframe);
  568.            framecmdptr1^.user := USER ;
  569.            shortframe:=TRUE;
  570.         IF trace THEN BConOut(CON,".") END;
  571.         END;
  572.         FOR i1:=0 TO sndframesize-5 DO (* compute checksum *)
  573.             sframe.cksum:=sframe.cksum+CARDINAL(sframeptr^[i1])
  574.         END;
  575.         IF shortframe THEN framecmdptr1^.cksum:=sframe.cksum END;
  576.         FOR i1:=0 TO sndframesize-1 DO (* send frame *)
  577.             REPEAT
  578.                 nrecframe;
  579.             UNTIL BCosStat(netdevice); 
  580.             BConOut(netdevice,CHAR(sframeptr^[i1]));
  581.         END;
  582. END     sendf;
  583.  
  584. (*$P- *)
  585. PROCEDURE gettime;
  586. BEGIN
  587.         clock:=hz200 DIV 200;
  588.         CODE(RTS);
  589. END     gettime;
  590. (*$P+ *)
  591.  
  592. PROCEDURE getf(VAR f: frame);
  593. BEGIN
  594.         f:=rframe;
  595.         framebufferfull:=FALSE;
  596. END     getf;
  597.  
  598. PROCEDURE StartTimer;
  599. BEGIN
  600.         SuperExec(gettime);
  601.         timestart:=clock;  (* set to time in seconds *)
  602.         timer:=TRUE;                      (* test *)
  603.         timefortimeout:=timestart;
  604.         IncTime(timefortimeout,2);
  605. END     StartTimer;
  606.  
  607. PROCEDURE IncTime(VAR t : LONGCARD; c: CARDINAL);
  608. BEGIN
  609.         IF c<1 THEN RETURN END;
  610.         t:=t+LONGCARD(c);
  611. END     IncTime;
  612.  
  613. PROCEDURE TimeOut(): BOOLEAN;
  614. BEGIN
  615.         IF (NOT timer) THEN RETURN FALSE END;
  616.         SuperExec(gettime);
  617.         timeouttime:=clock;
  618.         SETREG(0,timeouttime);
  619.         CODE(0280H,0,0FFFFH);
  620.         timeouttime:=LONGCARD(REGISTER(0));
  621.         IF timeouttime>timefortimeout THEN
  622.            StartTimer;
  623.            RETURN TRUE;
  624.         END;
  625.         RETURN FALSE;
  626. END     TimeOut;
  627.  
  628. PROCEDURE Nwait(VAR e: evtype);
  629. BEGIN
  630.  
  631.          IF requesttosend AND cleartosend THEN
  632.             e:=hostready;
  633.             requesttosend:=FALSE;
  634.             cleartosend:=FALSE;
  635.             RETURN;
  636.          END;
  637.  
  638.          IF C.sendreset THEN
  639.             e:=reset;
  640.          END;
  641.  
  642.          IF framebufferfull THEN
  643.            cksum:=0;
  644.            FOR i2:=0 TO recframesize-5 DO
  645.               cksum:=cksum+CARDINAL(rframeptr^[i2])
  646.            END;
  647.            IF (cksum=rframe.cksum) THEN
  648.               e:=framearrival;
  649.               INC(R);
  650.            ELSE
  651.               e:=cksumerr;
  652.               framebufferfull:=FALSE;
  653.         IF trace THEN BConOut(CON,"U") END;
  654.            END;
  655.            RETURN;
  656.          END;            
  657.          nrecframe;
  658.          IF TimeOut() THEN
  659.             e:=timeout; 
  660.             INC(R);
  661.          END;     (* so sorry no frame ack *) 
  662. END     Nwait;
  663.  
  664. PROCEDURE ToHost(VAR f: frame);
  665. BEGIN
  666.         IF trace THEN BConOut(CON,"H") END;
  667.         IF f.kind=callreq THEN
  668.            framewaiting:=FALSE;
  669.            RETURN;
  670.         END;
  671.         IF f.kind=clearreq THEN
  672.            framewaiting:=FALSE;
  673.            RETURN;
  674.         END;
  675.         IF f.kind=diag THEN
  676.            framewaiting:=FALSE;
  677.            RETURN;
  678.         END;
  679.         IF f.kind=data THEN
  680.            IF f.cmd=rdmediareq THEN
  681.         IF trace THEN BConOut(CON,"M") END;
  682.               framewaiting:=FALSE;
  683.               nframe2.d0:=LONGCARD(MediaChange(CARDINAL(f.d0)));
  684.               sendtoremote(data,rdmediaconf,nframe2);
  685.               RETURN;
  686.            END;
  687.            IF f.cmd=rdbpbreq THEN
  688.         IF trace THEN BConOut(CON,"P") END;
  689.               framewaiting:=FALSE;
  690.               nframe2.d0:=LONGCARD(GetBPB(CARDINAL(f.d0)));
  691.               bpbptr:=ADDRESS(nframe2.d0);
  692.               nbpbptr:=ADR(nframe2.info);
  693.               FOR i:=0 TO TSIZE(BPB)-1 DO
  694.                   nbpbptr^[i]:=bpbptr^[i];    
  695.               END;
  696.               sendtoremote(data,rdbpbconf,nframe2);
  697.               RETURN;
  698.            END;
  699.            IF f.cmd=rdrwabsreq THEN
  700.         IF trace THEN BConOut(CON,"W") END;
  701.               framewaiting:=FALSE;
  702.               nframe2.d0:=LONGCARD(RWAbs(RW(f.rw),ADR(f.info),1,f.recno,
  703.                                    CARDINAL(f.d0)));
  704.               IF (f.rw=0) OR (f.rw=2) THEN
  705.                  nframe2.rw:=f.rw;
  706.                  nframe2.info:=f.info; (* if rec get buffer to send *)
  707.               END;
  708.               sendtoremote(data,rdrwabsconf,nframe2);
  709.               RETURN;
  710.            END;
  711.         END;
  712. END     ToHost;
  713.  
  714. PROCEDURE HandleEvents();
  715. BEGIN
  716.             IF event=hostready THEN
  717.                event:=nothing;
  718.         IF trace THEN BConOut(CON,"S") END;
  719.                senddata;
  720.             END;
  721.  
  722.             IF event=reset THEN
  723.         IF trace THEN BConOut(CON,"I") END;
  724.                charcount:=0;
  725.                R:=0;
  726.                gotframe:=FALSE;
  727.                framebufferfull:=FALSE;
  728.                FOR d:=0 TO 5 DO
  729.                    gotmediach[d]:=FALSE;
  730.                    gotbpb[d]:=FALSE;
  731.                END;
  732.                C.nextframetosend:=0;
  733.                C.frameexpected:=0;
  734.                cleartosend:=TRUE;
  735.                requesttosend:=FALSE;
  736.                framewaiting:=FALSE;
  737.                timer:=FALSE;
  738.                C.sendreset:=FALSE;
  739.                event:=nothing;
  740.                SFRAME.kind:=resetreq;
  741.                senddata;
  742.             END;
  743.  
  744.             IF event=framearrival THEN
  745.                event:=nothing;
  746.  
  747.                IF (rframe.kind=ack) OR (rframe.kind=resetreq) THEN
  748.                   framewaiting:=FALSE
  749.                END;
  750.         IF trace AND (NOT framewaiting) THEN BConOut(CON,"F") END;
  751.  
  752.                IF (NOT framewaiting) THEN getf(RFRAME) END; 
  753.                framebufferfull:=FALSE;
  754.  
  755.                IF (RFRAME.ack=C.nextframetosend) OR debug THEN
  756.         IF trace THEN BConOut(CON,"K") END;
  757.                   cleartosend:=TRUE;
  758.                   StartTimer;
  759.                   R:=0;
  760.                   timer:=FALSE;
  761.                   inc(C.nextframetosend);
  762.                END;
  763.  
  764.                IF (RFRAME.seq=C.frameexpected) OR debug THEN
  765.         IF trace THEN BConOut(CON,"E") END;
  766.                   IF RFRAME.kind#ack THEN (* try to exec command *)
  767.                      inc(C.frameexpected); 
  768.                      framewaiting:=TRUE;
  769.                      R:=0;
  770.                      ToHost(RFRAME);
  771.                   END;
  772.                END;
  773.                IF RFRAME.kind=resetreq THEN
  774.         IF trace THEN BConOut(CON,"*") END;
  775.                   charcount:=0;
  776.                   gotframe:=FALSE;
  777.                   framebufferfull:=FALSE;
  778.                   C.nextframetosend:=0;
  779.                   C.frameexpected:=0;
  780.                   FOR d:=0 TO 5 DO
  781.                       gotmediach[d]:=FALSE;
  782.                       gotbpb[d]:=FALSE;
  783.                   END;
  784.                   cleartosend:=TRUE;
  785.                   requesttosend:=FALSE;
  786.                   framewaiting:=FALSE;
  787.                   timer:=FALSE;
  788.                   C.sendreset:=FALSE;
  789.                   event:=nothing;
  790.                   BConOut(CON,BEL);
  791.                   BConOut(CON,BEL);
  792.                END;
  793.             END;
  794.  
  795.         SFRAME.seq:=C.nextframetosend;
  796.         SFRAME.ack:=1-C.frameexpected;
  797.  
  798.         IF event=timeout THEN
  799.            event:=nothing;
  800.         IF trace THEN BConOut(CON,"R") END;
  801.            sendf(SFRAME);
  802.            framewaiting:=FALSE;
  803.         END;
  804. END     HandleEvents;
  805.  
  806. PROCEDURE       recframe;
  807. BEGIN
  808.         nrecframe;
  809.         Nwait(event);
  810.         HandleEvents();
  811. END     recframe;
  812.  
  813. PROCEDURE       initnetwork(port: Device);
  814. BEGIN
  815.   netdevice:=port;
  816.   IF Initialise(port) THEN
  817.  
  818.     charcount:=0;
  819.     gotframe:=FALSE;
  820.     framebufferfull:=FALSE;
  821.     C.nextframetosend:=0;
  822.     C.frameexpected:=0;
  823.     FOR d:=0 TO 5 DO
  824.         gotmediach[d]:=FALSE;
  825.         gotbpb[d]:=FALSE;
  826.     END;
  827.     cleartosend:=TRUE;
  828.     requesttosend:=FALSE;
  829.     framewaiting:=FALSE;
  830.     timer:=FALSE;
  831.     C.sendreset:=FALSE;
  832.     event:=nothing;
  833.     C.networkactive:=TRUE;
  834.     IF NOT installed THEN
  835.       SuperExec(PROC(InstallVectors)) ; (* install the NETWORK *)
  836.       installed:=TRUE;
  837.     END;
  838.   END ;
  839. END   initnetwork;
  840.  
  841. PROCEDURE       networkoff;
  842. BEGIN
  843.     C.networkactive:=FALSE;
  844. END     networkoff;
  845.  
  846. PROCEDURE       networkon;
  847. BEGIN
  848.     C.networkactive:=TRUE;
  849. END     networkon;
  850.  
  851. BEGIN
  852. END NETWORK.
  853.