[comp.sources.atari.st] v01i084: mx2v230 -- Multitasking kernel with utilities part04/08

koreth@ssyx.ucsc.edu.ucsc.edu (Steven Grimm) (12/27/88)

Submitted-by: madsen@sask.usask.ca (Jorgen Madsen)
Posting-number: Volume 1, Issue 84
Archive-name: mx2v230/part04

#!/bin/sh
# this is part 4 of a multipart archive
# do not concatenate these parts, unpack them in order with /bin/sh
# file MX2.MOD continued
#
CurArch=4
if test ! -r s2_seq_.tmp
then echo "Please unpack part 1 first!"
     exit 1; fi
( read Scheck
  if test "$Scheck" != $CurArch
  then echo "Please unpack part $Scheck next!"
       exit 1;
  else exit 0; fi
) < s2_seq_.tmp || exit 1
sed 's/^X//' << 'SHAR_EOF' >> MX2.MOD
X        m:=LONGCARD(WShr(WAnd(time,2016),5));    (* minutes *)
X        s:=2*LONGCARD(WAnd(time,31));            (* seconds *)
X        RETURN s+(m*60)+(h*3600);
XEND             converttime;
X
X(*$P- *)
XPROCEDURE       gettick;
XBEGIN
X        temphz200:=hz200;
X        CODE(4e75H); (* rts *)
XEND     gettick;
X(*$P+ *)
X
X(*$P- *)
XPROCEDURE       setvector;
XBEGIN
X        linea:=s0^.gemsave[1];
X        gemdos:=s0^.gemsave[2];
X        gsxgem:=s0^.gemsave[3];
X        tbios:=s0^.gemsave[4];
X        xbios:=s0^.gemsave[5];
X        linef:=s0^.gemsave[6];
X        level2:=s0^.gemsave[7];
X        level4:=s0^.gemsave[8];
X        shellp:=s0^.gemsave[9];
X        currentprocess^.Oport:=s0^.Oport;
X        currentprocess^.Iport:=s0^.Iport;
X        CODE(4e75H); (* rts *)
XEND     setvector;
X(*$P+ *)
X
X(*$P- *)
XPROCEDURE       getvector;
XBEGIN
X        SetDrvPath(defaultdrv,defaultpath);
X        linea:=gemsave[1];
X        gemdos:=gemsave[2];
X        gsxgem:=gemsave[3];
X        tbios:=gemsave[4];
X        xbios:=gemsave[5];
X        linef:=gemsave[6];
X        level2:=gemsave[7];
X        level4:=gemsave[8];
X        shellp:=gemsave[9];
X        currentprocess^.Oport:=devicetype(gemsave[10]);
X        currentprocess^.Iport:=devicetype(gemsave[10]);
X        CODE(4e75H); (* rts *)
XEND     getvector;
X(*$P+ *)
X
X(*$P- *)
XPROCEDURE       getbiosvector;
XBEGIN
X        tbios:=gemsave[4];
X        currentprocess^.Oport:=devicetype(gemsave[10]);
X        currentprocess^.Iport:=devicetype(gemsave[10]);
X        CODE(4e75H); (* rts *)
XEND     getbiosvector;
X(*$P+ *)
X
X(*$P- *)
XPROCEDURE       savevector;
XBEGIN
X        GetPath(defaultpath,0);
X        GetDrv(defaultdrv);
X        requestdrv:=defaultdrv;
X        requestpath:=defaultpath;
X        gemsave[1]:=linea;
X        gemsave[2]:=gemdos;
X        gemsave[3]:=gsxgem;
X        gemsave[4]:=tbios;
X        gemsave[5]:=xbios;
X        gemsave[6]:=linef;
X        gemsave[7]:=level2;
X        gemsave[8]:=level4;
X        gemsave[9]:=shellp;
X        gemsave[10]:=ADDRESS(con);
X        returnadr:=termvec;
X        oldikbd:=ADDRESS(ikbdvec);
X        ikbdvec:=keytrapstart;
X        CODE(4e75H); (* rts *)
XEND     savevector;
X(*$P+ *)
X
XPROCEDURE       readcrontab;
XVAR             result,i                          : INTEGER;
X                S                                 : Stream;
X                entry,parm                        : String;
XBEGIN
X        OpenStream(S,"CRONTAB",READ,result);
X        IF result=0 THEN
X           WHILE NOT EOS(S) DO
X                 REadString(S,entry);
X                 scinit(ADR(entry),SIZE(entry));
X                 nxparm;
X                 ltext(ADR(parm),SIZE(parm));
X                 ConvertFromString(parm,10,FALSE,MAX(LONGCARD),
X                                   crontable[i].stime,done);
X                 crontable[i].stime:=crontable[i].stime*60;
X                 nxparm;
X                 ltext(ADR(parm),SIZE(parm));
X                 ConvertFromString(parm,10,FALSE,MAX(LONGCARD),
X                                   crontable[i].freq,done);
X                 crontable[i].freq:=crontable[i].freq*60;
X                 nxparm;
X                 etext(ADR(parm),SIZE(parm));
X                 crontable[i].command:=parm;
X                 crontable[i].active:=TRUE;
X                 INC(i);
X           END;
X           CloseStream(S,result);
X        ELSE
X           CronActive:=FALSE;
X        END;
XEND     readcrontab;
X
XPROCEDURE       LoadCRON; (* crontable loader *)
XBEGIN
X  SuperExec(gettick);
X  cronslice:=temphz200;
X  GetTime(i);
X  currenttime:=converttime(i); (* convert time to seconds *)
X  ticktime:=LONGINT(temphz200 DIV 200)-LONGINT(currenttime);
X       (* ticktime is 200hz clock at 00:00    *)
X  FOR i:=0 TO 15 DO               (* clear crontable *)
X      crontable[i].active:=FALSE;
X  END;
X  readcrontab;
X  FOR i:=0 TO 15 DO
X    IF crontable[i].active THEN
X     IF currenttime>crontable[i].stime THEN
X        periods:=((currenttime-crontable[i].stime) DIV crontable[i].freq)+1;
X        crontable[i].btime:=LONGCARD(ticktime+LONGINT(periods*crontable[i].freq));
X        crontable[i].btime:=(crontable[i].stime+crontable[i].btime)*200;
X     ELSE
X        crontable[i].btime:=LONGCARD(ticktime+LONGINT(crontable[i].stime));
X        crontable[i].btime:=crontable[i].btime*200;
X     END;
X    END;
X  END;
XEND             LoadCRON;
X
XPROCEDURE       TIMER;
XVAR             i       :       CARDINAL;
XBEGIN
X     IF NOT request.req THEN
X      LOOP;
X        FOR i:=0 TO 15 DO
X            IF crontable[i].active THEN
X               IF currentprocess^.slice>crontable[i].btime THEN
X                  REPEAT (* advance to next time slot *)
X                        INC(crontable[i].btime,(crontable[i].freq*200));
X                  UNTIL crontable[i].btime>currentprocess^.slice;
X                  command:=crontable[i].command;
X                  request.magic:=MAGIC;
X                  request.pid:=currentprocess^.pid;
X                  currentprocess^.ipenvstr:=defaultpath;
X                  currentprocess^.flags[0]:=LONGCARD(defaultdrv);
X                  request.req:=TRUE;
X                  EXIT; (* loop *)
X               END;
X            END;
X        END;
X        EXIT; (* loop *)
X      END; (* loop *)
X     END; (* if *)
XEND     TIMER;
X
XPROCEDURE       HOTKEYER;
XVAR             i,pid,t         :       INTEGER;
XBEGIN
X    IF swloaded THEN
X       s0:=currentprocess;
X       REPEAT
X             s0:=s0^.next
X       UNTIL s0^.pid=cli1;
X       IF s0^.wsp=NIL THEN
X          BConOut(CON,33C);
X          BConOut(CON,'f');
X          screensave^[1]:=physcreen^;
X          physcreen^:=screensave^[2];
X          screensave^[2]:=screensave^[1];
X          BConOut(CON,33C);
X          BConOut(CON,'e');
X          WakeupProcess(clipid);
X          swloaded:=FALSE;
X          done:=Free(ADDRESS(screensave));
X          RETURN;
X       END;
X       BConOut(CON,33C);
X       BConOut(CON,'f');
X       screensave^[1]:=physcreen^;
X       physcreen^:=screensave^[2];
X       screensave^[2]:=screensave^[1];
X       BConOut(CON,33C);
X       BConOut(CON,'e');
X       SleepProcess(cli1);
X       WakeupProcess(cli2);
X       t:=cli1;
X       cli1:=cli2;
X       cli2:=t;
X    END;
X    IF (NOT swloaded) THEN
X       physcreen:=ScreenPhysicalBase();
X       Alloc(64000,screensave);
X       IF ADDRESS(screensave)=NIL THEN RETURN END;
X       BConOut(CON,33C);
X       BConOut(CON,'f');
X       screensave^[2]:=physcreen^;
X       SleepProcess(clipid);
X       cli1:=NextPid(); (* get the pid for the new cli *)
X       cli2:=clipid;
X       BConOut(CON,33C);
X       BConOut(CON,'e');
X       WriteLn;
X       WriteString("Enter name of program to run: ");
X       WriteLn;
X       WriteString("Press RETURN to run CLI ");
X       ReadString(command);
X       IF command[0]=0c THEN
X          command:="cli";
X       END;
X       Concat("fp ",command,command);
X       tail:="";
X       envstr:="";
X       request.magic:=MAGIC;
X       request.req:=TRUE;
X       Use;
X       swloaded:=TRUE;
X    END;
XEND             HOTKEYER;
X
XPROCEDURE       SysGen;
XBEGIN
X  initprg:="IP CLI.PRG";
X  SYSMEM:=7D00H; (* Allocated memory for MX2 use *)
X  HotKey:=320000H; (* ALT m *)
X  NorMouse:=310000H; (* ALT n *)
X  CurMouse:=2E0000H; (* ALT c *)
X  RebootKey:=130000H; (* ALT r *)
X  memreserve:=7D00H; (* reserved memory for alt HOTKEY program *)
X  ReadMX2INF;
XEND             SysGen;
X
XPROCEDURE       ReadMX2INF;
XVAR             result                            : INTEGER;
X                S                                 : Stream;
X
XPROCEDURE       getparm(VAR p: LONGCARD); (* read in info file *)
XVAR     V       :       ADDRESS;
XBEGIN
X     REadString(S,temp);
X     ConvertToAddr(temp,done,V);
X     p:=LONGCARD(V);
XEND             getparm;
X
XBEGIN
X        OpenStream(S,"MX2.INF",READ,result);
X        IF result=0 THEN
X           REadString(S,initprg); (* get command *)
X           getparm(SYSMEM);
X           getparm(HotKey);
X           getparm(NorMouse);
X           getparm(CurMouse);
X           getparm(RebootKey);
X           getparm(memreserve);
X           CloseStream(S,result);
X        END;
XEND     ReadMX2INF;
X
X(*$P-,$S- *)
XPROCEDURE       initsetup;
XBEGIN
X        currentprocess^.Oport:=con;
X        currentprocess^.Iport:=con;
X        CODE(4e75H);    (* RTS *)
XEND             initsetup;
X(*$P+,$S+ *)
X
X(* ------------------------------------------------------------------- *)
X
XPROCEDURE       init;
XBEGIN
X  WriteString(TDI);
X  WriteLn;
X  Initsked;
X
X  MultiEnd;
X  SuperExec(initsetup);
X  Alloc(memreserve+2,cmd); (* use spare address vars to setup memory block *)
X  Alloc(2,dev);
X  reservemem:=Free(cmd);
X  OpenCLI := 0;
X
X  MultiEnd;
X  spawnpid:=NextPid();
X  command:="BP 1 spawn";
X  request.pid:=currentprocess^.pid; 
X  request.magic:=MAGIC;
X  request.req:=TRUE;
X  MultiEnd;
X  Use; (* execute command *)
X
X  MultiEnd;
X  clipid:=NextPid();
X  command:=initprg;
X  request.pid:=currentprocess^.pid; 
X  request.magic:=MAGIC;
X  request.req:=TRUE;
X  MultiEnd;
X  Use; (* execute command *)
X  REPEAT
X        SwapProcess; 
X  UNTIL OpenCLI>0;
X
X  CRON:=TIMER; 
X  CronActive:=TRUE;
X  LoadCRON; (* read CRONFILE and set up crontable variables *)
X  kbdiorec:=IORec(Keyboard);
X  ibuf:=kbdiorec^.ibuf;
X  SuperExec(tbiossetup);
X
X LOOP                   (* main kernel loop runs "forever" *)
X     MultiEnd;
X     Kshift:=GetKBShift();
X     IF Kshift=CapsL THEN
X        IF (NOT caps) THEN
X           caps:=TRUE;
X           BConOut(CON,33C);
X           BConOut(CON,'j');
X           BConOut(CON,33C);
X           BConOut(CON,'Y');
X           BConOut(CON,CHAR(32));
X           BConOut(CON,CHAR(111));
X           BConOut(CON,'*');
X           BConOut(CON,33C);
X           BConOut(CON,'k');
X        END;
X     ELSE
X        IF caps THEN
X           caps:=FALSE;
X           BConOut(CON,33C);
X           BConOut(CON,'j');
X           BConOut(CON,33C);
X           BConOut(CON,'Y');
X           BConOut(CON,CHAR(32));
X           BConOut(CON,CHAR(111));
X           BConOut(CON,' ');
X           BConOut(CON,33C);
X           BConOut(CON,'k');
X        END;
X     END;
X
X        IF swapcli THEN
X           swapcli:=FALSE;
X           HOTKEYER;
X        END;
X     IF currentprocess^.slice>cronslice+6000 THEN (* every 30 SECONDS *)
X        cronslice:=currentprocess^.slice;
X
X        IF CronActive THEN
X           SuperExec(getvector);
X           CRON 
X        END;
X     END;
X     IF CARDINAL(spintenable)#0 THEN (* check for spints *)
X        FOR i:=0 TO 15 DO (* check all spints and run if set *)
X            IF (i IN spintenable)
X               AND (i IN spintmask) 
X               AND (ADDRESS(spint[i].proc)#NIL) THEN
X               spint[i].proc;
X            END;
X            EXCL(spintenable,i); (* clear flag after complete *)
X        END;
X     END;
X
X     IF request.req THEN
X        s0:=currentprocess;
X        REPEAT
X              s0:=s0^.next
X        UNTIL s0^.pid=request.pid;
X        i:=CARDINAL(s0^.flags[0]);
X        SetDrvPath(i,s0^.ipenvstr);
X        requestdrv:=i;
X        requestpath:=s0^.ipenvstr;
X        SuperExec(setvector); 
X        Use;
X        request.req:=FALSE;
X     END;
X     MultiBegin;
X     SwapProcess;
X  END;
XEND     init;
X
X(* ------------------------------------------------------------------- *)
X
XBEGIN
X        SuperExec(savevector);
X        BConOut(CON,33C);
X        BConOut(CON,'E');
X        Hotset:=KBShifts{AlternateKey};
X        CapsL:=KBShifts{CapsLock};
X        IF (ROMDATE # OLDDATE) AND (ROMDATE # NEWDATE) THEN
X           WriteLn;
X           WriteString("SORRY, MX2 MAY NOT RUN WITH YOUR ROM VERSION.");
X           WriteLn;
X        END;
X        SysGen; (* read in system generation file if any *)
X        IF CreateHeap(SYSMEM,TRUE) THEN
X           sysmemsize:=SYSMEM;
X           Oportdevice:=con;
X           Iportdevice:=con;
X           inuse:=FALSE;
X           done:=TRUE;
X           InitProcesses;
X           request.pid:=currentprocess^.pid;
X           MultiEnd;
X           WriteLn;
X           WriteString(TITLE1);
X           WriteString(VERSION);
X           WriteString(TITLE2);
X           WriteLn;
X           proc:=init;
X           sizewsp:=2000;
X           pri:=1;
X           pname:="init";
X           par:=NIL;
X           StartProcess(proc,sizewsp,pri,pname,par);
X        END;
X        OldTerm;
XEND MX2.
X
SHAR_EOF
chmod 0600 MX2.MOD || echo "restore of MX2.MOD fails"
sed 's/^X//' << 'SHAR_EOF' > MX2LIB.C &&
X/* These are some interface routines for MX2 using C. It is written     */
X/* using Mark Johnson's Shareware C compiler version 1.2                */
X/* If I receive requests maybe I will write a complete interface or     */
X/* someone else can feel free.                                          */
X
X
X#define MX2GLOBAL       0x144L
X#define MX2MAGIC        22261L
Xstruct  PIPE    {
X        char    pipename[80];
X        short   buf[1024];
X        int     bufsize;
X        int     bufhead;
X        int     buftail;
X        int     cnt;
X};
Xstruct  sysreq  {
X        int     req;
X        int     pid;
X        long    magic;
X};
Xstruct  spinttype {
X        long    proc;
X        int     pid;
X        long    data;
X};
Xstruct  sysvar  {
X        long    *currentprocess;
X        int     *MULTI;
X        long    *slicebegin;
X        long    *contextswitch;
X        long    *command;
X        long    *request;
X        long    *CRON;
X        int     *spintenable;
X        int     *spintmask;
X        long    *spint;
X        long    *bpsave;
X        long    *pipes;
X        long    *sysmemsize;
X        long    *gemsaveGvec;
X        long    *StartProcess; /* The following are pointers to fuctions */
X        long    *SwapProcess;
X        long    *TermProcess;
X        long    *NextPid;
X        long    *SleepProcess;
X        long    *WakeupProcess;
X        long    *ChangeProcessPriority;
X        long    *MultiBegin;
X        long    *MultiEnd;
X        long    *DozeProcess;
X        long    *WaitProcess;
X};
X        struct  sysvar  *mx2var;
X
Xmain()
X{
X        long    *contextswitch,*sysmemsize;
X
X        GetSysVar(); /* store mx2 system variable pointers in mx2var */
X        contextswitch = (long *) mx2var->contextswitch;
X        printf("Total context switches  %lu   / address %lx / \n",
X                *contextswitch,contextswitch);
X        sysmemsize = (long *) mx2var->sysmemsize;
X        printf("MX2 system memory  %lu   / address %lx / \n\n",
X                *sysmemsize,sysmemsize);
X        exit(0);
X}
X
X/*      This routine will read MX2 system variables and procedures      */
X/*      and return them as a pointer in mx2var.                         */
Xvoid    GetSysVar()
X{
X        long    *adr,ssv;
X
X        ssv = 0L;
X        ssv = (long *) trap(1,0x20,ssv);
X        adr = MX2GLOBAL;           /* system variable address pointer */
X        mx2var = (struct sysvar *) *adr;
X        ssv = trap(1,0x20,ssv);
X}
SHAR_EOF
chmod 0600 MX2LIB.C || echo "restore of MX2LIB.C fails"
sed 's/^X//' << 'SHAR_EOF' > MX2NET.MOD &&
X
X(*              Copyright 1987 fred brooks LogicTek             *)
X(*                                                              *)
X(*                                                              *)
X(*   First Release                      12/8/87-FGB             *)
X(*                                                              *)
X
XMODULE mx2net; (*$S-,$T-,$A+ *)
XFROM    SYSTEM  IMPORT  CODE,ADDRESS;
XFROM    NETWORK IMPORT  initnetwork,recframe;
XFROM    GEMX    IMPORT  BasePageAddress;
XFROM    GEMDOS  IMPORT  TermRes,Super;
XFROM    BIOS    IMPORT  Device;
XVAR
X       vblptr [456H]                            : POINTER TO ARRAY [0..7]
X                                                  OF ADDRESS;
X       i                                        : CARDINAL;
X       ssv                                      : ADDRESS;
X
X(*      it runs as a background process in a vbl time slot              *)
X(*$P- *)
XPROCEDURE VBLrecframe; 
XBEGIN
X        CODE(02f39H,0,04a2H); (* move.l $4a2,-(sp) save BIOS pointer *)
X        CODE(04b9H,0,02eH,0,04a2H); (* sub 46 from pointer *)
X        recframe; (* check network for data *)
X        CODE(023dfH,0,04a2H); (* restore BIOS pointer *)
X        CODE(4e75H); (* rts *)
XEND     VBLrecframe;
X(*$P+ *)
X
XBEGIN
X        initnetwork(HSS);
X        i:=0;
X        ssv:=0;
X        Super(ssv);
X        WHILE vblptr^[i]#0H DO
X              INC(i);
X        END;
X         (* set up vbl vector for NETWORK input *)
X        vblptr^[i] := ADDRESS(VBLrecframe);
X        Super(ssv);
X    WITH BasePageAddress^ DO
X    TermRes(CodeLen+BssLen+LONGCARD(CodeBase-ADDRESS(BasePageAddress)),0);
X    END;
XEND     mx2net.
X
SHAR_EOF
chmod 0600 MX2NET.MOD || echo "restore of MX2NET.MOD fails"
sed 's/^X//' << 'SHAR_EOF' > MX2NOTES.TXT &&
Xnotes.txt
XThese are working notes to help keep track of changes or things that
Xshould or could be done to MX2.
X
X
X#@MX2 file and program directorys
XThere are two new directory that MX2 needs. The first is called \MX2SPOOL
Xthis is created when the spooler program begins for the first time.
XThe second is called \MX2 these should be where all MX2 executable
Xprograms should be. All script file should now look at \MX2 for MX2
Xprograms that they need.
X
X#@mlimit
XNeed a way to limit the amount that any one program can see with a
Xmalloc(-1). I could set up a trap handler to control the malloc but I will
Xfirst try to allocate small 2 byte memory blocks to break up the memory
Xblock.
X
X#@crashs
XWhen MX2 crashes disk sectors that were being allocated for a file that did
Xnot close can be lost. Use of a program like "TUNEUP" can fix and get back
Xthe "LOST" sectors. Also some auto programs can cause problems with MX2
XI use GEMBOOT.PRG and the mitchtron CACHE.PRG. I have found that the
XL-CACHE.PRG causes lockup and random aborts.
X
X#@xmodem
XNeed to take a look to see why the xmodem routines are messing up later
XI/O with the te command and CLI redirection to the AUX port.
X
X#@menu
XI have started to play with a backgound gem menu bar for the CLI. The
Xprogram MENU sets up a menu bar that can be run in backgound with the
X"sys bp 1 menu" command. The program 'km' will terminate the MENU 
Xprogram. Although it works it also totally screws up gem. It's safer run
Xas just a regular program but it you don't care about running another gem
Xprogram try it.
X
X#@WaitProcess MX2V220
XProcedure that waits for a memory location to change it's value.
X   WaitProcess(VAR id: INTEGER; VAR location: ADDRESS; VAR value,mask,msec: LONGCARD);
XThis procedure puts the currentprocess to sleep then compares the contents
Xat 'location' against 'value AND mask'. If they are the same then the
Xprocess wakes up and is put in the scheduler ready list to be run. msec
Xis the time the process will wait for the value in milliseconds if msec
Xis set to 0 WaitProcess will never timeout.
X** NEED TO ADD TO JSM2 syscall.def
X
X#@submita&submitm
XFixed submita and added submitm to utility programs. I forgot to use the
Xxbios call to get the IOREC for the RS232 buffer.
X
X@#mx2.acc
XIf you want to switch out of a GEM program back to the ALT cli with the
XALT m hotkey you MUST turn off the MX2.ACC first. If you don't the AES
Xwill get very mixed up. When back in the GEM program you can turn the
XMX2.ACC back on to allow normal background program operation. This guy is
Xcauseing some problems I may have to redesign it again.
X
X@#spint control of spooler, network and xmodem
Xspint 0 controls the spooler
Xspint 1 controls both netaux and netmidi
Xspint 2 controls the xmodem send and receive
Xxr = xmodem receive  'xr -crc foo.bar' or 'xr -chk foo.bar'
Xxt = xmodem send     'xt -crc foo.bar' or 'xr -chk foo.bar'
Xxs = xmodem status   'xs'
Xxa = xmodem abort    'xa'
X
X@#spints
XSpints in MX2 are similar to signals in UNIX. They are procedures that
Xcan be started by issueing a Trigger(x) call. A spint can also carry a
Xmemory location that can be used for shared memory between processes.
XThe source files spooler.mod, sq.mod, lp.mod and killlp.mod are simple
Xexamples.
Xspooler.mod uses the EnableSpint call to setup spint 0 to a procedure
Xsq and a pointer to the variable spintcmd.
Xsq.mod, lp.mod and killlp.mod use the SpintInfo and Trigger calls to
Xcommunicate with the spooler.prg
X
X
SHAR_EOF
chmod 0600 MX2NOTES.TXT || echo "restore of MX2NOTES.TXT fails"
sed 's/^X//' << 'SHAR_EOF' > NETAUX.MOD &&
X(*$T-,$S-,$A+ *)
XMODULE  netaux;
XFROM    NETWORK         IMPORT  initnetwork,recframe;
XFROM    BIOS            IMPORT  Device;
XFROM    SYSCALL         IMPORT  SwapProcess;
XBEGIN
X        initnetwork(AUX);
X        LOOP
X                recframe;
X                SwapProcess;
X        END;
XEND     netaux.
X
SHAR_EOF
chmod 0600 NETAUX.MOD || echo "restore of NETAUX.MOD fails"
sed 's/^X//' << 'SHAR_EOF' > NETMIDI.MOD &&
X(*$T-,$S-,$A+ *)
XMODULE  netmidi;
XFROM    NETWORK         IMPORT  initnetwork,recframe;
XFROM    BIOS            IMPORT  Device;
XFROM    SYSCALL         IMPORT  SwapProcess;
XBEGIN
X        initnetwork(HSS);
X        LOOP
X                recframe;
X                SwapProcess;
X        END;
XEND     netmidi.
X
SHAR_EOF
chmod 0600 NETMIDI.MOD || echo "restore of NETMIDI.MOD fails"
sed 's/^X//' << 'SHAR_EOF' > NETWORK.DEF &&
X
X(*              Copyright 1987 fred brooks LogicTek             *)
X(*                                                              *)
X(*                                                              *)
X(*   First Release                      12/8/87-FGB             *)
X(* Added support for use of MIDI or AUX port for network        *)
X(*                                      2/6/88-FGB              *)
X(*                                                              *)
X
XDEFINITION MODULE NETWORK;
XFROM        BIOS    IMPORT    Device;
XVAR         netdevice         :    Device;
XPROCEDURE       initnetwork(port: Device);
X(* install network, default is network on ,MIDI port *)
XPROCEDURE       recframe;    (* check network for received data *)
XPROCEDURE       networkoff;  (* turn on network *)
XPROCEDURE       networkon;   (* turn off network *)
X
XEND  NETWORK.
SHAR_EOF
chmod 0600 NETWORK.DEF || echo "restore of NETWORK.DEF fails"
sed 's/^X//' << 'SHAR_EOF' > NETWORK.MOD &&
X
X(*              Copyright 1987 fred brooks LogicTek             *)
X(*                                                              *)
X(*                                                              *)
X(*   First Release                      12/8/87-FGB             *)
X(*                                                              *)
X
XIMPLEMENTATION MODULE NETWORK ;
X
X(* --------------------------------------------------------------------------
X
X               NETWORK : MIDI PORT TWO CPU NETWORK FOR TDI Modula-2/ST
X
X   --------------------------------------------------------------------------*)
X
X(*$T-,$S-,$A+ *)
X
XFROM SYSTEM IMPORT ADDRESS, ADR, SETREG, CODE, REGISTER ,BYTE ,TSIZE;
XFROM BIOS   IMPORT BPB ,BConStat ,BConIn, BCosStat, BConOut, Device,
X                   MediaChange,MCState,GetBPB,RWAbs,RW,DriveSet,DriveMap;
XFROM XBIOS  IMPORT SuperExec,IORec,IORECPTR,IOREC,SerialDevice;
XFROM GEMDOS IMPORT TermRes,Open,Close ;
XIMPORT             GEMDOS;
XFROM ASCII  IMPORT SYN,STX,SOH,BEL;
X
XCONST
X  MaxSeq          = 1;
X  recsize         = 511;
X  USER            = 324159265;
X  retry           = 10;
X  debug           = FALSE;
X  trace           = FALSE;
X
X  (* Because we dont know what registers the BIOS is using we must use
X     the following opcodes to save the registers *)
X  MOVEMDEC = 48E7H ;    (* 68000 opcode for MOVEM <regs>,-(A7) *)
X  MOVEMINC = 4CDFH ;    (* 68000 opcode for MOVEM (A7)+,<regs> *)
X  SAVEREGS = 07FFCH ;   (* Registers D1..A5 for DEC *)
X  RESTREGS = 03FFEH ;   (* Registers D1..A5 for INC *)
X  RTS = 04E75H ;        (* 68000 return from subroutine opcode *)
X
XTYPE
X  (* Procedure types to mimic correct sequence for "C" BIOS routines *)
X
X  CBPBProc     = PROCEDURE ( CARDINAL ) ;
X  CMediaChProc = PROCEDURE ( CARDINAL ) ;
X  CRWAbsProc   = PROCEDURE ( CARDINAL, CARDINAL, CARDINAL, ADDRESS, CARDINAL );
X  MIDIbuffer   = ARRAY [0..512] OF CARDINAL;
X  SequenceNr   = [0..MaxSeq];
X  message      = ARRAY [0..recsize] OF BYTE;
X  message1     = ARRAY [0..17] OF BYTE;
X  FrameKind    = (ack,data,callreq,callaccp,clearreq,clearconf,
X                 resetreq,resetconf,diag);
X  DataKind     = (rdmediareq,rdmediaconf,rdbpbreq,rdbpbconf,
X                 rdrwabsreq,rdrwabsconf);
X  evtype       = (framearrival,cksumerr,timeout,hostready,reset,nothing);
X
X  frame        = RECORD
X                 syn    :       CHAR; (* these are sync chars *)
X                 stx    :       CHAR; (* for the frames       *)
X                 kind   :       FrameKind;
X                 seq    :       SequenceNr;
X                 ack    :       SequenceNr;
X                 cmd    :       DataKind;
X                 rw     :       CARDINAL; (* read or write data *)
X                 recno  :       CARDINAL; (* sector for data*)
X                 d0     :       LONGCARD; (* data return variable *)
X                 info   :       message;
X                 user   :       LONGCARD;
X                 cksum  :       CARDINAL;
X               END;
X
X  framecptr    = POINTER TO framecmd;
X  framecmd     = RECORD
X                 syn    :       CHAR; (* these are sync chars *)
X                 stx    :       CHAR; (* for the frames       *)
X                 kind   :       FrameKind;
X                 seq    :       SequenceNr;
X                 ack    :       SequenceNr;
X                 cmd    :       DataKind;
X                 rw     :       CARDINAL; (* read or write data *)
X                 recno  :       CARDINAL; (* sector for data*)
X                 d0     :       LONGCARD; (* data return variable *)
X                 info   :       message1;
X                 user   :       LONGCARD;
X                 cksum  :       CARDINAL;
X               END;
X
X  control     = RECORD
X                 magic          :       LONGCARD;
X                 reset          :       BOOLEAN;
X                 networkactive  :       BOOLEAN;
X                 remotedrive    :       CARDINAL;
X                 drivemap       :       DriveSet;
X                nextframetosend :      SequenceNr;
X                frameexpected   :      SequenceNr;
X                sendreset       :      BOOLEAN;
X               END;
X
X  consave     = RECORD
X                 magic          :       LONGCARD;
X                 reset          :       BOOLEAN;
X                 networkactive  :       BOOLEAN;
X                END;
X
X  frameptr      =       POINTER TO ARRAY [0..1024] OF BYTE;
X
XVAR
X
X
X  (* BIOS variables : These can only be accessed with the 68000 in supervisor
X     mode. The Modula-2 language allows you to fix the location of variables *)
X
X  HDBPB     [0472H] : ADDRESS ;       (* hard disk get Bios Parameter Block *)
X  HDRWAbs   [0476H] : ADDRESS ;       (* hard disk read/write abs   *)
X  HDMediaCh [047EH] : ADDRESS ;       (* hard disk media change     *)
X  DriveBits [04C2H] : SET OF [0..31]; (* disk drives present map    *)
X  flock     [043EH] : LONGCARD;       (* disk access in progress    *)
X  hz200     [04baH] : LONGCARD;       (* 200hz clock counter        *)
X  clock             : LONGCARD;
X  Dptr              : DriveSet;       (* save original drive map    *)
X  Mptr              : LONGCARD;
X  charcount,j,framesize,cksum,recframesize,sndframesize,
X  SIZEframe,SIZEframecmd                                : CARDINAL;
X
X  networkconnect          :   BOOLEAN; (* DCD = 1 TRUE  *)
X  gotframe                :   BOOLEAN;
X  framebufferfull         :   BOOLEAN;
X  cleartosend             :   BOOLEAN;
X  readytosend             :   BOOLEAN;
X  requesttosend           :   BOOLEAN;
X  framewaiting            :   BOOLEAN;
X  timer,OK,installed      :   BOOLEAN;
X  gotmediach              :   ARRAY [0..5] OF BOOLEAN;
X  gotbpb                  :   ARRAY [0..5] OF BOOLEAN;
X  networkerror            :   BOOLEAN;
X  shortframe              :   BOOLEAN;
X  sendlong                :   BOOLEAN;
X
X  sframe,rframe,SFRAME,RFRAME,
X  nframe1,nframe2                  :   frame;
X  rframeptr,sframeptr,
X  bpbptr,nbpbptr                   :   frameptr;
X  framecmdptr,framecmdptr1         :   framecptr;
X  event                            :   evtype;
X  C                                :   control;
X  recchar,timestart,timefortimeout,timeouttime :   LONGCARD;
X  timestart1,timefortimeout1,timeouttime1      :   LONGCARD;
X  result,r,i,i1,i2,i3,mediacount,handle        :   INTEGER;
X  D0ptr                                        :   POINTER TO LONGCARD;
X  wsector,drvnr,DriveA,DriveF,devicestart,d,R  :   CARDINAL;
X  rbuffer                                      :   MIDIbuffer;
X  rbptr                                        :   IORECPTR;
X  numBytes,sec,min,hour,time,count             :   LONGCARD ;
X  status                                       :   LONGINT ;
X
X  (* The following are saved copies of the BIOS variables so that the real
X     hard disk routines can be called if a hard disk access is requested. *)
X
X  SaveHDBPB      : CBPBProc ;     (* hard disk get Bios Parameter Block *)
X  SaveHDRWAbs    : CRWAbsProc ;   (* hard disk read/write abs *)
X  SaveHDMediaCh  : CMediaChProc ; (* hard disk media change *)
X
X  (* NETWORK control *)
X
X  NetworkBPB  : ARRAY [0..5] OF BPB ; (* BIOS Parameter block for NETWORK *)
X
XPROCEDURE MoveMemory ( From, To : ADDRESS ; Bytes : LONGCARD ) ;
X(* This routine shows how time critical portions of code can be optimised to
X   run faster. It relys on the code generation rules of the compiler which 
X   can be checked by dis-assembling the link file with DecLnk.*)
X
XCONST
X  MOVEB = 12D8H ;       (*      MOVE.B  (A0)+,(A1)+     *)
X  MOVEL = 22D8H ;       (*      MOVE.L  (A0)+,(A1)+     *)
X  A0    = 0+8 ;         (* register A0 *)
X  A1    = 1+8 ;         (* register A1 *)
X
XBEGIN
X  SETREG(A0,From) ;             (* load From pointer into A0 *)
X  SETREG(A1,To) ;               (* load To pointer into A1 *)
X  
X  IF ( ODD(From) OR ODD(To) ) THEN      (* must do bytes *)
X    WHILE ( Bytes <> 0 ) DO
X      CODE(MOVEB) ;
X      DEC(Bytes) ;
X    END ;
X  ELSE (* even addresses so can do long moves *)
X    WHILE ( Bytes > 3 ) DO
X      CODE(MOVEL) ;
X      DEC(Bytes,4) ;
X    END ;
X    WHILE ( Bytes <> 0 ) DO
X      CODE(MOVEB) ;             (* clean up remainder *)
X      DEC(Bytes) ;
X    END ;
X  END ;
XEND MoveMemory ;
X
X
XPROCEDURE inc(VAR k: SequenceNr);   (* increment k circulary *)
XBEGIN
X        IF k<MaxSeq THEN k:=k+1 ELSE k:=0 END;
XEND     inc;
X
X
X(* The following procedures mimic the disk handling routines called by the
X   BIOS. Their procedure declarations have been written to mimic the "C"
X   calling sequence. *)
X
XPROCEDURE RDRWAbs ( device, RecordNum, SectorCount : CARDINAL ;
X                    Buffer : ADDRESS ; Flag : CARDINAL ) ;
X(* NB. It is assumed that GEMDOS wont call this routine with out of range
X   parameters *)
XCONST D0 = 0 ;
XBEGIN
X  CODE(MOVEMDEC,SAVEREGS) ;     (* save registers on stack *)
X  status := 0;
X  IF (device >= DriveA) AND (device <=DriveF) THEN (* is NETWORK channel *)
X    IF ( Flag = 0 ) OR ( Flag = 2 ) (* read *)  THEN
X       FOR wsector:=0 TO (SectorCount-1) DO
X           C.remotedrive:=device-devicestart; 
X           nframe1.d0:=LONGCARD(device-devicestart);
X           nframe1.recno:=RecordNum+wsector;
X           nframe1.rw:=Flag; (* read *)
X           resetnewdisk;
X           IF getfromremote(rdrwabsreq,rdrwabsconf,nframe1) THEN
X              MoveMemory(ADR(nframe1.info),Buffer+ADDRESS(wsector)*512,
X                         512);
X              status:=0;
X           ELSE
X              status:=(-11);
X           END; (* if *)
X       END; (* for *)
X    IF networkerror THEN C.sendreset:=TRUE END; (* send network reset to remote cpu *)
X      SETREG(D0,status) ;
X    ELSIF ( Flag = 1 ) OR ( Flag = 3 ) THEN (* write *)
X       FOR wsector:=0 TO (SectorCount-1) DO
X           C.remotedrive:=device-devicestart; 
X           nframe1.d0:=LONGCARD(device-devicestart);
X           nframe1.recno:=RecordNum+wsector;
X           nframe1.rw:=Flag; (* write *)
X           resetnewdisk;
X           MoveMemory(Buffer+ADDRESS(wsector)*512,ADR(nframe1.info),512);
X           IF getfromremote(rdrwabsreq,rdrwabsconf,nframe1) THEN
X              status:=0;
X           ELSE
X              status:=(-10);
X           END;
X       END; (* for *)
X    IF networkerror THEN C.sendreset:=TRUE END; (* send network reset to remote cpu *)
X      SETREG(D0,status) ;
X    ELSE
X      SETREG(D0,LONGINT(-3)) ;
X    END ;
X  ELSE (* not NETWORK *)
X    SaveHDRWAbs (device,RecordNum,SectorCount,Buffer,Flag) ;
X  END ;
X  CODE(MOVEMINC,RESTREGS) ;     (* Restore registers from stack *)
XEND RDRWAbs ;
X
XPROCEDURE RDMediaCh ( device : CARDINAL ) ;
XCONST D0 = 0 ;
XBEGIN
X  CODE(MOVEMDEC,SAVEREGS) ;     (* save registers on stack *)
X  IF (device >= DriveA) AND (device <=DriveF) THEN (* is NETWORK channel *)
X    C.remotedrive:=device-devicestart; 
X    nframe1.d0:=LONGCARD(device-devicestart);
X    IF newdisk() THEN
X       gotmediach[device-devicestart]:=FALSE;
X       gotbpb[device-devicestart]:=FALSE;
X    END;
X    IF (NOT gotmediach[device-devicestart]) THEN
X     IF getfromremote(rdmediareq,rdmediaconf,nframe1) THEN 
X        gotmediach[device-devicestart]:=TRUE;
X        IF nframe1.d0=1 THEN nframe1.d0:=2 END;
X        SETREG(D0,nframe1.d0) ;    (* "C" uses D0 as return location *)
X     ELSE
X        SETREG(D0,Changed);
X     END;
X    ELSE
X       SETREG(D0,NoChange) ;    (* "C" uses D0 as return location *)
X    END; 
X  ELSE (* not NETWORK *)
X    SaveHDMediaCh(device) ;
X  END;
X  CODE(MOVEMINC,RESTREGS) ;     (* Restore registers from stack *)
SHAR_EOF
echo "End of part 4, continue with part 5"
echo "5" > s2_seq_.tmp
exit 0