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