koreth@ssyx.ucsc.edu.ucsc.edu (Steven Grimm) (12/27/88)
Submitted-by: madsen@sask.usask.ca (Jorgen Madsen)
Posting-number: Volume 1, Issue 82
Archive-name: mx2v230/part02
#!/bin/sh
# this is part 2 of a multipart archive
# do not concatenate these parts, unpack them in order with /bin/sh
# file ATOMIC.MOD continued
#
CurArch=2
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' >> ATOMIC.MOD
X END;
X NEWPROCESS(dummy,ADR(wsp1),TSIZE(workspace),x);
X NEWPROCESS(dummy,ADR(wsp2),TSIZE(workspace),p);
X NEWPROCESS(dummy,ADR(wsp3),TSIZE(workspace),t);
X currentprocess^.wsp:=ADR(wsp2);
X currentprocess^.cor:=p;
XEND InitProcesses;
X
XPROCEDURE EndProcesses;
XBEGIN
X s0:=currentprocess;
X REPEAT
X currentprocess:=s0^.next;
X s0:=currentprocess;
X UNTIL currentprocess^.pid=0;
X SuperExec(restorebiosptr);
X INC(contextswitch); (* update switch counter *)
X TRANSFER(currentprocess^.cor,currentprocess^.cor);
XEND EndProcesses;
X
X(* This is the scheduler which is called by newtrap *)
XPROCEDURE sched;
XBEGIN
X IOTRANSFER(cotick,x,ADDRESS(trapvec)); (* V1.1 baud rate timer *)
X LOOP (* interrupt not used by ST *)
X currentprocess^.cor:=x;
X currentprocess^.ready:=FALSE;
X currentprocess^.intflag:=TRUE; (* process interrupted *)
X INC(contextswitch); (* update switch counter *)
X currentprocess:=s0; (* s0 set to new in newtrap procedure *)
X currentprocess^.ready:=TRUE; (* process to start *)
X x:=currentprocess^.cor;
X IOTRANSFER(cotick,x,ADDRESS(offsetvec)); (* offset vector so not *)
X END; (* to overwrite the *)
XEND sched; (* newtrap vector *)
X
XPROCEDURE SwapProcess; (* swap out processes *)
XBEGIN
X IntEnd;
X SuperExec(UpdatecurrentProc);
X s0:=currentprocess;
X currentprocess^.ready:=FALSE;
X LOOP (* find next process *)
X currentprocess:=currentprocess^.next;
X IF currentprocess^.active AND (currentprocess^.wsp#NIL) THEN
X EXIT
X END;
X END; (* loop *)
X currentprocess^.ready:=TRUE;
X IF s0^.pid#currentprocess^.pid THEN
X SuperExec(UpdateProc);
X TRANSFER(s0^.cor,currentprocess^.cor);
X END;
X IntBegin;
XEND SwapProcess;
X
X(*$P- *)
XPROCEDURE UpdateProc; (* update all currentprocess values *)
XBEGIN
X currentprocess^.slice:=hz200;
X ClrInt;
X SetTimer;
X setbiosptr;
X INC(contextswitch); (* update switch counter *)
X CODE(4e75H); (* rts *)
XEND UpdateProc;
X(*$P+ *)
X
X(*$P- *)
XPROCEDURE UpdatecurrentProc;
XBEGIN
X getbiosptr;
X IncSlice;
X CODE(4e75H); (* rts *)
XEND UpdatecurrentProc;
X(*$P+ *)
X
XPROCEDURE dummy; (* dummy procedure to make newprocess *)
XBEGIN
XEND dummy;
X
XPROCEDURE d1(): BOOLEAN;
XBEGIN
XEND d1;
X
XPROCEDURE d2(c: CHAR);
XBEGIN
XEND d2;
X
XPROCEDURE d3(): LONGCARD;
XBEGIN
XEND d3;
X(* check to see if process s0 is a ZOMBIE, if so return true else false *)
XPROCEDURE FindZombieProcess(VAR zombie: BOOLEAN);
XBEGIN
X IF (NOT s0^.active) AND (s0^.pid#0) AND (s0^.wsp=NIL) THEN
X zombie:=TRUE; (* found one *)
X ELSE
X zombie:=FALSE; (* nada it's alive! *)
X END;
XEND FindZombieProcess;
X
XPROCEDURE FindProcess(VAR pid: INTEGER; VAR fp: SIGNAL);
XBEGIN
X s:=schedproc;
X LOOP (* find process id *)
X s:=s^.next;
X IF (s^.pid=pid) AND (s^.wsp#NIL) THEN (* found id *)
X fp:=s;
X EXIT;
X END;
X IF s^.pid=schedproc^.pid THEN (* id not found in list *)
X fp:=NIL;
X EXIT;
X END;
X END;
XEND FindProcess;
X
XPROCEDURE FindChildProcess(VAR pid: INTEGER; VAR fp: SIGNAL);
XBEGIN
X s:=schedproc;
X LOOP (* find process child id *)
X s:=s^.next;
X IF (s^.ppid=pid) AND (s^.wsp#NIL) THEN (* found id *)
X fp:=s;
X EXIT;
X END;
X IF s^.pid=schedproc^.pid THEN (* id not found in list *)
X fp:=NIL;
X EXIT;
X END;
X END;
XEND FindChildProcess;
X
X(*$P- *)
XPROCEDURE IncSlice; (* UPDATE cpu time *)
XBEGIN
X INC(currentprocess^.tick,hz200-currentprocess^.slice);
X currentprocess^.slice:=hz200;
X CODE(4e75H); (* rts *)
XEND IncSlice;
X(*$P+ *)
X
X(*$P- *)
XPROCEDURE SetSlice; (* start timeslice *)
XBEGIN
X temphz200:=hz200;
X CODE(4e75H); (* rts *)
XEND SetSlice;
X(*$P+ *)
X
X(*$P- *)
XPROCEDURE SetTimer; (* setup number of ticks before switch V1.1 *)
XBEGIN
X TICKS:=hz200+LONGCARD(currentprocess^.pri*10);
X CODE(4e75H); (* rts *)
XEND SetTimer;
X(*$P+ *)
X
X(*$P- *)
XPROCEDURE ClrInt; (* V1.2 change to int on mfp *)
XBEGIN
X CODE(8b9H,intnum,0ffffH,0fa11H); (* BCLR intnum, ISRB *)
X CODE(8b9H,intnum,0ffffH,0fa15H); (* BCLR intnum, MASKB *)
X CODE(4e75H); (* rts *)
XEND ClrInt;
X(*$P+ *)
X
X(*$P- *)
XPROCEDURE EnableInterrupt;
XBEGIN (* setup sched vector interrupt *)
X SETREG(8,0fffffa15H); (* load a0 with adr of mfp reg *)
X CODE(8d0H,intnum); (* set int mask bit *)
X CODE(4e75H); (* rts *)
XEND EnableInterrupt;
X(*$P+ *)
X
XPROCEDURE MultiBegin;
XBEGIN
X SuperExec(ClrInt);
X SuperExec(SetTimer);
X MULTI:=TRUE;
XEND MultiBegin;
X
XPROCEDURE MultiEnd;
XBEGIN
X MULTI:=FALSE;
X SuperExec(ClrInt);
XEND MultiEnd;
X
XPROCEDURE IntBegin;
XVAR ssv : ADDRESS;
XBEGIN
X ssv:=0H;
X Super(ssv);
X CODE(46fcH,2300H); (* start interrupts *)
X Super(ssv);
XEND IntBegin;
X
XPROCEDURE IntEnd;
XVAR ssv : ADDRESS;
XBEGIN
X ssv:=0H;
X Super(ssv);
X CODE(46fcH,2700H); (* stop interrupts *)
X Super(ssv);
XEND IntEnd;
X
X(*$P- *)
XPROCEDURE getbiosptr;
XBEGIN
X WITH currentprocess^ DO
X biosval:=biospointer+46;
X termvec:=ptermvec;
X gemsave[0]:=gemsaveGvec^;
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 END;
X CODE(4e75H); (* rts *)
XEND getbiosptr;
X(*$P+ *)
X
X(*$P- *)
XPROCEDURE setbiosptr;
XBEGIN
X WITH currentprocess^ DO
X savefrom:=ADDRESS(biospointer);
X saveto:=ADDRESS(biosval-46);
X saveto^:=savefrom^;
X biospointer:=biosval-46;
X ptermvec:=termvec;
X gemsaveGvec^:=gemsave[0];
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 END;
X CODE(4e75H); (* rts *)
XEND setbiosptr;
X(*$P+ *)
X
X(*$P- *)
XPROCEDURE restorebiosptr;
XBEGIN
X savefrom:=biospointer;
X saveto:=bios;
X saveto^:=savefrom^;
X biospointer:=bios;
X ptermvec:=oldtermvec;
X CODE(4e75H); (* rts *)
XEND restorebiosptr;
X(*$P+ *)
X
X(*$P- *)
XPROCEDURE intbiosptr;
XBEGIN
X WITH currentprocess^ DO
X savefrom:=ADDRESS(biospointer);
X saveto:=ADR(biosave[199]);
X saveto^:=savefrom^;
X biosval:=ADR(biosave[199]);
X biospointer:=biosval;
X termvec:=ptermvec;
X gemsave[0]:=gemsaveGvec^;
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 END;
X CODE(4e75H); (* rts *)
XEND intbiosptr;
X(*$P+ *)
X
X(*$P- *)
XPROCEDURE newtrap; (* IOTRANSFER executes this code before its *)
XBEGIN (* normal vector. *)
X
X CODE(46fcH,2700H); (* stop interrupts *)
X CODE(8b9H,intnum,0ffffH,0fa11H); (* BCLR intnum, ISRB *)
X CODE(8b9H,intnum,0ffffH,0fa15H); (* BCLR intnum, MASKB *)
X CODE(817H,5); (* BTST 5, (a7) check supermode *)
X CODE(6700H+2); (* BEQ.S over rte *)
X CODE(4e73H); (* RTE supermode return *)
X CODE(48e7H,0fffeH); (* save regs movem *)
X CODE(204fH); (* move.l ssp,a0 *)
X currentprocess^.ssp:=REGISTER(8)+66;
X
X IF (currentprocess^.ssp#sspval)
X AND (currentprocess^.ssp#accsuperstack) THEN
X CODE(4cdfH,7fffH); (* restore regs movem *)
X CODE(4e73H); (* rte *)
X ELSE
X
X IncSlice; (* cpu time update *)
X s0:=currentprocess;
X LOOP (* find next process store in s0 *)
X s0:=s0^.next;
X WITH s0^ DO
X IF (gemsave[14]#0) THEN (* If flags set then process *)
X CPFlagptr:=ADR(gemsave[14]);
X
X IF sleep IN CPFlagptr^ THEN (* sleep flag *)
X IF (gemsave[13]#0) AND
X (ADDRESS(hz200) >= gemsave[13]) THEN
X active:=TRUE;
X gemsave[13]:=0;
X EXCL(CPFlagptr^,wait); (* clear wait flag *)
X EXCL(CPFlagptr^,sleep); (* clear sleep flag *)
X END;
X END;
X IF wait IN CPFlagptr^ THEN (* wait flag *)
X IF (waitloc^ = LONGCARD(LAnd(gemsave[11],gemsave[12]))) THEN
X active:=TRUE;
X gemsave[13]:=0;
X EXCL(CPFlagptr^,wait); (* clear wait flag *)
X EXCL(CPFlagptr^,sleep); (* clear sleep flag *)
X END;
X END;
X
X END;
X IF (active) AND (wsp#NIL) THEN
X IF misc[0]>=highpri THEN
X IF pri>highpri THEN highpri:=pri END;
X misc[0]:=pri;
X EXIT;
X ELSE
X INC(misc[0]); (* age process til it's ready to run *)
X END;
X END;
X END; (* with *)
X END; (* end LOOP *)
X
X (* Swap GEM pointers for the processes *)
X WITH currentprocess^ DO
X gemsave[0]:=gemsaveGvec^;
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 biosval:=biospointer;
X termvec:=ptermvec;
X END;
X WITH s0^ DO
X biospointer:=biosval;
X ptermvec:=termvec;
X gemsaveGvec^:=gemsave[0];
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 END;
X
X SetTimer;
X s0^.slice:=hz200; (* set next cycle start *)
X SETREG(8,oldtrap); (* move IOTRANSFER trap adr *)
X CODE(43faH,10); (* lea 12(pc),a1 *)
X CODE(2288H); (* move.l a0,(a1) *)
X CODE(4cdfH,7fffH); (* restore regs movem *)
X CODE(4ef9H,0,0) (* jmp back to routine *)
X END;
XEND newtrap;
X(*$P+ *)
X
X(*$P-,$S- *)
XPROCEDURE NewEtimer;
XBEGIN
X CODE(48e7H,0fffeH); (* save regs movem *)
X IF MULTI THEN
X CODE(207cH,0ffffH,0fa15H); (* load a0 with adr of mfp reg *)
X CODE(8d0H,intnum); (* set int mask bit *)
X CODE(5188H); (* subq.l 8 adj a0 to adr of mfp reg *)
X CODE(5988H); (* subq.l 4 adj a0 to adr of mfp reg *)
X CODE(8d0H,intnum); (* set int enable bit *)
X END;
X
X SETREG(8,OldEtimer); (* move trap adr *)
X CODE(43faH,6); (* lea 8(pc),a1 *)
X CODE(2288H); (* move.l a0,(a1) *)
X CODE(4ef9H,0,0); (* jmp back to routine *)
XEND NewEtimer;
X(*$P+,$S- *)
X
X(*$P- *) (*save trap and set up flag trap for IOTRANSFER to run my code *)
XPROCEDURE settrap; (* before executing the IOTRANSFER. *)
XBEGIN
X CODE(46fcH,2700H); (* stop interrupts V1.1 use 200hz clock *)
X TICKS:=10;
X OldEtimer:=etimer+4;
X etimer:=ADDRESS(NewEtimer);
X EnableInterrupt;
X MULTI:=FALSE;
X oldtrap:=trap+4; (* add 4 to skip over set SR to 2700 *)
X trap:=ADDRESS(newtrap);
X CODE(46fcH,2300H); (* allow interrupts V1.1 *)
X accsuperstack:=sysvector; (* load value from MX2.ACC *)
X sysvector:=ADR(sysvar); (* setup sysvar pointers *)
X sysvar.currentprocess:=ADR(currentprocess);
X sysvar.MULTI:=ADR(MULTI);
X sysvar.slicebegin:=ADR(slicebegin);
X sysvar.command:=ADR(command);
X sysvar.request:=ADR(request);
X sysvar.contextswitch:=ADR(contextswitch);
X sysvar.CRON:=ADR(CRON);
X sysvar.spintenable:=ADR(spintenable);
X sysvar.spintmask:=ADR(spintmask);
X
X sysvar.spint:=ADR(spint[0]);
X sysvar.bpsave:=ADR(bpsave);
X sysvar.pipes:=ADR(pipes);
X sysvar.sysmemsize:=ADR(sysmemsize);
X sysvar.gemsaveGvec:=ADR(gemsaveGvec);
X sysvar.StartProcess:=StartProcess;
X sysvar.SwapProcess:=SwapProcess;
X sysvar.TermProcess:=TermProcess;
X sysvar.NextPid:=NextPid;
X sysvar.SleepProcess:=SleepProcess;
X sysvar.WakeupProcess:=WakeupProcess;
X sysvar.ChangeProcessPriority:=ChangeProcessPriority;
X sysvar.MultiBegin:=MultiBegin;
X sysvar.MultiEnd:=MultiEnd;
X sysvar.DozeProcess:=DozeProcess;
X sysvar.WaitProcess:=WaitProcess;
X sysvar.CronActive:=ADR(CronActive);
X sysvar.DeviceTable:=ADR(DeviceTable);
X FOR I:=ORD(dev0) TO ORD(dev7) DO (* setup user device table *)
X DeviceTable[I].bconstat:=devstattype(d1);
X DeviceTable[I].bcostat:=devstattype(d1);
X DeviceTable[I].bconin:=devintype(d3);
X DeviceTable[I].bconout:=devouttype(d2);
X END;
X FOR I:=0 TO 31 DO (* clear all pipes *)
X pipes[I]:=NIL;
X END;
X FOR I:=0 TO 15 DO (* clear all spints *)
X spint[I].proc:=PROC(NIL);
X END;
X slicebegin:=hz200;
X contextswitch:=0;
X bios:=biospointer; (* save original pointer *)
X oldtermvec:=ptermvec;
X CODE(4e75H); (* rts *)
X
XEND settrap;
X(*$P+ *)
X
XPROCEDURE Initsked;
XVAR a,b,ssv : ADDRESS;
XBEGIN
X MultiEnd;
X a:=ADDRESS(OTOS);
X b:=ADDRESS(MTOS);
X gemsaveGvec:=a;
X IF ROMDATE=NEWDATE THEN gemsaveGvec:=b END;
X SuperExec(SetTimer);
X NEWPROCESS(sched,ADR(wsp0),TSIZE(workspace),cotick);
X TRANSFER(x,cotick);
X schedproc:=currentprocess;
X SuperExec(settrap);
X ssv:=0H;
X Super(ssv);
X sspval:=ssv;
X Super(ssv);
XEND Initsked;
X
XPROCEDURE CheckFlag(VAR flag: BOOLEAN): BOOLEAN;
XBEGIN
X IF flag THEN
X RETURN TRUE;
X ELSE
X RETURN FALSE;
X END;
XEND CheckFlag;
X
XPROCEDURE SetFlag(VAR flag: BOOLEAN);
XBEGIN
X flag:=TRUE;
XEND SetFlag;
X
XPROCEDURE ResetFlag(VAR flag: BOOLEAN);
XBEGIN
X flag:=FALSE;
XEND ResetFlag;
X
XPROCEDURE CheckResetFlag(VAR flag: BOOLEAN): BOOLEAN;
XBEGIN
X IF flag THEN
X flag:=FALSE;
X RETURN TRUE;
X ELSE
X RETURN FALSE;
X END;
XEND CheckResetFlag;
X
XBEGIN
XEND ATOMIC.
SHAR_EOF
chmod 0600 ATOMIC.MOD || echo "restore of ATOMIC.MOD fails"
sed 's/^X//' << 'SHAR_EOF' > BITSTUFF.DEF &&
XDEFINITION MODULE BitStuff;
X
XFROM SYSTEM IMPORT BYTE, WORD, LONGWORD;
X
XPROCEDURE LAnd( op1, op2 : LONGWORD):LONGWORD;
XPROCEDURE LOr( op1, op2 : LONGWORD):LONGWORD;
XPROCEDURE LEor( op1, op2 : LONGWORD):LONGWORD;
XPROCEDURE LShl(number : LONGWORD; numbits : CARDINAL):LONGWORD;
XPROCEDURE LShr(number : LONGWORD; numbits : CARDINAL):LONGWORD;
X
XPROCEDURE WAnd( op1, op2 : WORD):WORD;
XPROCEDURE WOr( op1, op2 : WORD):WORD;
XPROCEDURE WEor( op1, op2 : WORD):WORD;
XPROCEDURE WShl(number : WORD; numbits : CARDINAL):WORD;
XPROCEDURE WShr(number : WORD; numbits : CARDINAL):WORD;
X
XPROCEDURE BAnd( op1, op2 : BYTE):BYTE;
XPROCEDURE BOr( op1, op2 : BYTE):BYTE;
XPROCEDURE BEor( op1, op2 : BYTE):BYTE;
XPROCEDURE BShl(number : BYTE; numbits : CARDINAL):BYTE;
XPROCEDURE BShr(number : BYTE; numbits : CARDINAL):BYTE;
X
XEND BitStuff.
SHAR_EOF
chmod 0600 BITSTUFF.DEF || echo "restore of BITSTUFF.DEF fails"
sed 's/^X//' << 'SHAR_EOF' > BITSTUFF.MOD &&
X(* Some Functions to perform bit manipulation.. bitsets are a 'bit'
X clumsy (pun intended) to use and don't operate on LONGWORDS,
X so i wrote this.
X It may not be the most efficient, but it is effective, enjoy..
X
X Russ Damske
X*)
X(*$T-,$S-,$A+ *)
XIMPLEMENTATION MODULE BitStuff;
X
XFROM SYSTEM IMPORT CODE,BYTE,WORD,LONGWORD, SETREG, REGISTER;
X
X(*** FOR LONGWORDS ***)
X
XPROCEDURE LAnd( op1, op2 : LONGWORD):LONGWORD;
X(* logically AND's 2 longwords *)
XBEGIN
X SETREG( 6, op1 );
X SETREG( 7, op2 );
X CODE( 0CE86H ); (* and d6,d7 *)
X RETURN LONGWORD( REGISTER( 7 ) );
XEND LAnd;
X
XPROCEDURE LOr(op1, op2 : LONGWORD):LONGWORD;
X(* logically OR's 2 longwords *)
XBEGIN
X SETREG( 6, op1 );
X SETREG( 7, op2 );
X CODE( 08E86H ); (* or d6,d7 *)
X RETURN LONGWORD( REGISTER( 7 ) );
XEND LOr;
X
XPROCEDURE LEor(op1, op2 : LONGWORD):LONGWORD;
X(* logically Exclusive OR of 2 longwords *)
XBEGIN
X SETREG( 6, op1 );
X SETREG( 7, op2 );
X CODE( 0BD87H ); (* eor d6,d7 *)
X RETURN LONGWORD( REGISTER( 7 ) );
XEND LEor;
X
XPROCEDURE LShl(number : LONGWORD; numbits : CARDINAL):LONGWORD;
X(* Shifts number an amount (numbits) left *)
XBEGIN
X CODE ( 07C00H ); (* moveq.l #0.d6 *)
X SETREG( 6, numbits );
X SETREG( 7, number );
X CODE( 0EDAFH ); (* lsl d6,d7 *)
X RETURN LONGWORD( REGISTER( 7 ) );
XEND LShl;
X
XPROCEDURE LShr(number : LONGWORD; numbits : CARDINAL):LONGWORD;
X(* Shifts number an amount (numbits) right *)
XBEGIN
X CODE( 07C00H ); (* moveq.l #0.d6 *)
X SETREG( 6, numbits );
X SETREG( 7, number );
X CODE( 0ECAFH ); (* lsr d6,d7 *)
X RETURN LONGWORD( REGISTER( 7 ) );
XEND LShr;
X
X(*** FOR WORDS ***)
X
XPROCEDURE WAnd( op1, op2 : WORD):WORD;
X(* logically AND's 2 words *)
XBEGIN
X SETREG( 6, op1 );
X SETREG( 7, op2 );
X CODE( 0CE46H ); (* and d6,d7 *)
X RETURN WORD( REGISTER( 7 ) );
XEND WAnd;
X
XPROCEDURE WOr(op1, op2 : WORD):WORD;
X(* logically OR's 2 ords *)
XBEGIN
X SETREG( 6, op1 );
X SETREG( 7, op2 );
X CODE( 08E46H ); (* or d6,d7 *)
X RETURN WORD( REGISTER( 7 ) );
XEND WOr;
X
XPROCEDURE WEor(op1, op2 : WORD):WORD;
X(* logically Exclusive OR of 2 words *)
XBEGIN
X SETREG( 6, op1 );
X SETREG( 7, op2 );
X CODE( 0BD47H ); (* eor d6,d7 *)
X RETURN WORD( REGISTER( 7 ) );
XEND WEor;
X
XPROCEDURE WShl(number : WORD; numbits : CARDINAL):WORD;
X(* Shifts number an amount (numbits) left *)
XBEGIN
X CODE ( 07C00H ); (* moveq.l #0.d6 *)
X SETREG( 6, numbits );
X SETREG( 7, number );
X CODE( 0ED6FH ); (* lsl d6,d7 *)
X RETURN WORD( REGISTER( 7 ) );
XEND WShl;
X
XPROCEDURE WShr(number : WORD; numbits : CARDINAL):WORD;
X(* Shifts number an amount (numbits) right *)
XBEGIN
X CODE( 07C00H ); (* moveq.l #0.d6 *)
X SETREG( 6, numbits );
X SETREG( 7, number );
X CODE( 0EC6FH ); (* lsr d6,d7 *)
X RETURN WORD( REGISTER( 7 ) );
XEND WShr;
X
X(*** FOR BYTES ***)
X
XPROCEDURE BAnd( op1, op2 : BYTE):BYTE;
X(* logically AND's 2 BYTES *)
XBEGIN
X SETREG( 6, op1 );
X SETREG( 7, op2 );
X CODE( 0CE06H ); (* and d6,d7 *)
X RETURN BYTE( REGISTER( 7 ) );
XEND BAnd;
X
XPROCEDURE BOr(op1, op2 : BYTE):BYTE;
X(* logically OR's 2 BYTES *)
XBEGIN
X SETREG( 6, op1 );
X SETREG( 7, op2 );
X CODE( 08E06H ); (* or d6,d7 *)
X RETURN BYTE( REGISTER( 7 ) );
XEND BOr;
X
XPROCEDURE BEor(op1, op2 : BYTE):BYTE;
X(* logically Exclusive OR of 2 BYTES *)
XBEGIN
X SETREG( 6, op1 );
X SETREG( 7, op2 );
X CODE( 0BD07H ); (* eor d6,d7 *)
X RETURN BYTE( REGISTER( 7 ) );
XEND BEor;
X
XPROCEDURE BShl(number : BYTE; numbits : CARDINAL):BYTE;
X(* Shifts number an amount (numbits) left *)
XBEGIN
X CODE ( 07C00H ); (* moveq.l #0.d6 *)
X SETREG( 6, numbits );
X SETREG( 7, number );
X CODE( 0ED2FH ); (* lsl d6,d7 *)
X RETURN BYTE( REGISTER( 7 ) );
XEND BShl;
X
XPROCEDURE BShr(number : BYTE; numbits : CARDINAL):BYTE;
X(* Shifts number an amount (numbits) right *)
XBEGIN
X CODE( 07C00H ); (* moveq.l #0.d6 *)
X SETREG( 6, numbits );
X SETREG( 7, number );
X CODE( 0EC2FH ); (* lsr d6,d7 *)
X RETURN BYTE( REGISTER( 7 ) );
XEND BShr;
X
XEND BitStuff.
SHAR_EOF
chmod 0600 BITSTUFF.MOD || echo "restore of BITSTUFF.MOD fails"
sed 's/^X//' << 'SHAR_EOF' > CLI.MOD &&
X
X(* Copyright 1987 fred brooks LogicTek *)
X(* *)
X(* *)
X(* First Release 12/8/87-FGB *)
X(* *)
X
XMODULE cli;
X(*$T-,$S-,$A+ *)
X(* IMPORT GEMError; *)
XFROM SYSTEM IMPORT ADDRESS, CODE, REGISTER, SETREG;
XFROM GEMDOS IMPORT Super,Exec,ExecMode,OldTerm;
XFROM BIOS IMPORT BConStat, BConIn, Device;
XFROM XBIOS IMPORT SuperExec;
XFROM LOGIN IMPORT login;
XVAR cmd,dev,sr,pc,oldbios,sp,tsp,usp,newbios : ADDRESS;
X bios [0b4H] : ADDRESS;
X d0,ssv,sspval : ADDRESS;
X i : INTEGER;
X active : BOOLEAN;
X delay,result : INTEGER;
X
X(*$P-,$S- *)
XPROCEDURE multitaskbios;
XBEGIN
X CODE(2279H,0,4a2H); (* load saveptr *)
X CODE(48e1H,1f1fH); (* save regs *)
X CODE(23c9H,0,4a2H); (* update saveptr *)
X IF active THEN
X SETREG(8,oldbios); (* move trap adr *)
X CODE(43faH,22); (* lea 26(pc),a1 *)
X CODE(2288H); (* move.l a0,(a1) *)
X CODE(2279H,0000,04a2H); (* get saveptr *)
X CODE(4cd9H,0f8f8H); (* restore regs movem *)
X CODE(23c9H,0000,04a2H); (* update saveptr *)
X CODE(4ef9H,0,0) (* jmp back to routine *)
X END;
X CODE(306fH,0); (* move.w 0(a7),a0 get sr *)
X sr:=REGISTER(8);
X CODE(206fH,2); (* move.l 2(a7),a0 get pc *)
X pc:=REGISTER(8);
X
X IF sr<3ffH THEN (* called from user mode *)
X CODE(4e69H); (* move.l usp,a1 *)
X CODE(3069H,2); (* move.w 2(a1),a0 *)
X dev:=REGISTER(8);
X CODE(4e69H); (* move.l usp,a1 *)
X CODE(3069H,0); (* move.w 0(a1),a0 *)
X cmd:=REGISTER(8);
X IF (cmd=2) THEN
X active:=TRUE;
X INC(delay);
X CODE(5c8fH); (* addq.l #6,a7 correct stack *)
X sp:=REGISTER(15);
X REPEAT
X (* set user mode then back to super *)
X IF sp=sspval THEN
X tsp:=REGISTER(15);
X CODE(4e68H); (* move.l usp,a0 *)
X usp:=REGISTER(8);
X CODE(46fcH,300H); (* move.w $300,sr *)
X FOR i:=0 TO 10 DO END; (* busy loop for mx2 *)
X CODE(42a7H); (* clr.l -(sp) *)
X CODE(3f3cH,20H); (* move.w $20,-(sp) *)
X CODE(4e41H); (* trap #1 *)
X SETREG(15,tsp);
X SETREG(8,usp);
X CODE(4e60H); (* move.l a0,usp *)
X END;
X CODE(48e7H,7ffeH); (* save regs *)
X CODE(9bcdH); (* clr a5 *)
X newbios:=bios;
X bios:=oldbios;
X SETREG(0,0);
X IF BConStat(Device(dev)) THEN SETREG(0,-1) END;
X bios:=newbios;
X CODE(4cdfH,7ffeH); (* restore regs *)
X d0:=REGISTER(0);
X UNTIL d0#0;
X CODE(48e7H,7ffeH); (* save regs *)
X CODE(9bcdH); (* clr a5 *)
X newbios:=bios;
X bios:=oldbios;
X SETREG(0,BConIn(Device(dev)));
X bios:=newbios;
X CODE(4cdfH,7ffeH); (* restore regs *)
X d0:=REGISTER(0);
X SETREG(9,pc);
X CODE(2f09H); (* push pc to stack *)
X SETREG(9,sr);
X CODE(3f09H); (* push sr to stack *)
X active:=FALSE;
X SETREG(0,d0); (* move char to d0 *)
X CODE(2279H,0000,04a2H); (* get saveptr *)
X CODE(4cd9H,0f8f8H); (* restore regs movem *)
X CODE(23c9H,0000,04a2H); (* update saveptr *)
X CODE(4e73H); (* rte *)
X END;
X IF (cmd=1) THEN
X active:=TRUE;
X INC(delay);
X CODE(5c8fH); (* addq.l #6,a7 correct stack *)
X sp:=REGISTER(15);
X CODE(48e7H,7ffeH); (* save regs *)
X CODE(9bcdH); (* clr a5 *)
X newbios:=bios;
X bios:=oldbios;
X SETREG(0,0);
X IF BConStat(Device(dev)) THEN SETREG(0,-1) END;
X bios:=newbios;
X d0:=REGISTER(0);
X CODE(4cdfH,7ffeH); (* restore regs *)
X IF d0=0 THEN
X (* set user mode then back to super *)
X IF sp=sspval THEN
X tsp:=REGISTER(15);
X CODE(4e68H); (* move.l usp,a0 *)
X usp:=REGISTER(8);
X CODE(46fcH,300H); (* move.w $300,sr *)
X FOR i:=0 TO 10 DO END; (* busy loop for mx2 *)
X CODE(42a7H); (* clr.l -(sp) *)
X CODE(3f3cH,20H); (* move.w $20,-(sp) *)
X CODE(4e41H); (* trap #1 *)
X SETREG(15,tsp);
X SETREG(8,usp);
X CODE(4e60H); (* move.l a0,usp *)
X END;
X END;
X SETREG(9,pc);
X CODE(2f09H); (* push pc to stack *)
X SETREG(9,sr);
X CODE(3f09H); (* push sr to stack *)
X active:=FALSE;
X SETREG(0,d0); (* move char to d0 *)
X CODE(2279H,0000,04a2H); (* get saveptr *)
X CODE(4cd9H,0f8f8H); (* restore regs movem *)
X CODE(23c9H,0000,04a2H); (* update saveptr *)
X CODE(4e73H); (* rte *)
X END;
X ELSE (* called from super mode *)
X CODE(306fH,8); (* move.w 8(a7),a0 *)
X dev:=REGISTER(8);
X CODE(306fH,6); (* move.w 6(a7),a0 *)
X cmd:=REGISTER(8);
X IF (cmd=2) THEN
X CODE(5c8fH); (* addq.l #6,a7 correct stack *)
X REPEAT
X CODE(48e7H,7ffeH); (* save regs *)
X CODE(9bcdH); (* clr a5 *)
X newbios:=bios;
X bios:=oldbios;
X SETREG(0,0);
X IF BConStat(Device(dev)) THEN SETREG(0,-1) END;
X bios:=newbios;
X CODE(4cdfH,7ffeH); (* restore regs *)
X d0:=REGISTER(0);
X UNTIL d0#0;
X CODE(48e7H,7ffeH); (* save regs *)
X CODE(9bcdH); (* clr a5 *)
X newbios:=bios;
X bios:=oldbios;
X SETREG(0,BConIn(Device(dev)));
X bios:=newbios;
X CODE(4cdfH,7ffeH); (* restore regs *)
X d0:=REGISTER(0);
X SETREG(9,pc);
X CODE(2f09H); (* push pc to stack *)
X SETREG(9,sr);
X CODE(3f09H); (* push sr to stack *)
X SETREG(0,d0); (* move char to d0 *)
X CODE(2279H,0000,04a2H); (* get saveptr *)
X CODE(4cd9H,0f8f8H); (* restore regs movem *)
X CODE(23c9H,0000,04a2H); (* update saveptr *)
X CODE(4e73H); (* rte *)
X END;
X END;
X
X SETREG(8,oldbios); (* move trap adr *)
X CODE(43faH,22); (* lea 26(pc),a1 *)
X CODE(2288H); (* move.l a0,(a1) *)
X CODE(2279H,0000,04a2H); (* get saveptr *)
X CODE(4cd9H,0f8f8H); (* restore regs movem *)
X CODE(23c9H,0000,04a2H); (* update saveptr *)
X CODE(4ef9H,0,0) (* jmp back to routine *)
X
XEND multitaskbios;
X(*$P+ *)
X
X(*$P- *)
XPROCEDURE dummyvector;
XBEGIN
X CODE(4e73H); (* rte *)
XEND dummyvector;
X(*$P+ *)
X
X(*$P- *)
XPROCEDURE setup;
XBEGIN
X oldbios:=bios;
X bios:=ADDRESS(multitaskbios);
X CODE(4e75H); (* RTS *)
XEND setup;
X(*$P+ *)
X
X(*$P- *)
XPROCEDURE setdown;
XBEGIN
X bios:=oldbios;
X CODE(4e75H); (* RTS *)
XEND setdown;
X(*$P+ *)
X
XBEGIN;
X ssv:=0H;
X Super(ssv);
X sspval:=ssv;
X Super(ssv);
X SuperExec(setup);
X login;
X SuperExec(setdown);
X OldTerm;
XEND cli.
SHAR_EOF
chmod 0600 CLI.MOD || echo "restore of CLI.MOD fails"
sed 's/^X//' << 'SHAR_EOF' > COM.MOD &&
X
X(* Copyright 1987 fred brooks LogicTek *)
X(* *)
X(* *)
X(* First Release 12/8/87-FGB *)
X(* *)
X
XMODULE com;
XFROM XBIOS IMPORT ConfigureRS232,SerialSpeed,FlowFlavor;
XFROM BIOS IMPORT BConStat,BCosStat,BConIn,BConOut,Device;
XFROM GEMX IMPORT BasePageAddress;
XFROM GEMDOS IMPORT OldTerm;
XVAR longchar : LONGCARD;
X t : BITSET;
X char : CHAR;
X port : Device;
XBEGIN
X char:=BasePageAddress^.CmdLine[1];
X IF (char='m') OR (char='M') THEN
X port:=HSS;
X ELSE
X port:=AUX;
X END;
X IF port=AUX THEN
X IF (char=0c) THEN
X ConfigureRS232(BPS1200,NONE,-1,-1,-1,-1);
X END;
X IF (char='0') THEN
X ConfigureRS232(BPS300,NONE,-1,-1,-1,-1);
X END;
X IF (char='1') THEN
X ConfigureRS232(BPS1200,NONE,-1,-1,-1,-1);
X END;
X IF (char='2') THEN
X ConfigureRS232(BPS2400,NONE,-1,-1,-1,-1);
X END;
X IF (char='4') THEN
X ConfigureRS232(BPS4800,NONE,-1,-1,-1,-1);
X END;
X IF (char='9') THEN
X ConfigureRS232(BPS9600,NONE,-1,-1,-1,-1);
X END;
X IF (char='h') OR (char='H') THEN
X ConfigureRS232(BPS19200,NONE,-1,-1,-1,-1);
X END;
X END;
X LOOP
X IF BConStat(CON) THEN (* read keyboard *)
X longchar:=BConIn(CON);
X IF (longchar DIV 65536) = 61H THEN EXIT END;
X char:=CHAR(longchar);
X BConOut(port,char);
X END;
X
X IF BConStat(port) THEN (* read com port *)
X longchar:=BConIn(port);
X t:=BITSET(longchar);
X EXCL(t,7);
X char:=CHAR(t);
X BConOut(CON,char);
X END;
X END;
X OldTerm;
XEND com.
SHAR_EOF
chmod 0600 COM.MOD || echo "restore of COM.MOD fails"
sed 's/^X//' << 'SHAR_EOF' > KILLLP.MOD &&
XMODULE killlp;
XFROM SYSCALL IMPORT Trigger,SpintInfo;
XFROM GEMDOS IMPORT Term;
XFROM SYSTEM IMPORT ADDRESS,ADR;
XFROM Terminal IMPORT WriteString,WriteLn;
XVAR ok : BOOLEAN;
X spintcmd : POINTER TO ARRAY [0..1] OF LONGCARD;
XBEGIN
X IF SpintInfo(0,spintcmd) THEN
X spintcmd^[0]:=99;
X ok:=Trigger(0);
X ELSE
X WriteLn;
X WriteString("Background spooler not running.");
X WriteLn;
X ok:=Term(-1);
X END;
X ok:=Term(0);
XEND killlp.
SHAR_EOF
chmod 0600 KILLLP.MOD || echo "restore of KILLLP.MOD fails"
sed 's/^X//' << 'SHAR_EOF' > LOGIN.DEF &&
XDEFINITION MODULE LOGIN;
X
X(* read passwd file and sign on user *)
XPROCEDURE login;
X
X(* encrypt password *)
XPROCEDURE crypt(VAR red,crypto: ARRAY OF CHAR);
X
XEND LOGIN.
X
SHAR_EOF
chmod 0600 LOGIN.DEF || echo "restore of LOGIN.DEF fails"
sed 's/^X//' << 'SHAR_EOF' > LOGIN.MOD &&
XIMPLEMENTATION MODULE LOGIN;
SHAR_EOF
echo "End of part 2, continue with part 3"
echo "3" > s2_seq_.tmp
exit 0