koreth@ssyx.ucsc.edu.ucsc.edu (Steven Grimm) (12/27/88)
Submitted-by: madsen@sask.usask.ca (Jorgen Madsen)
Posting-number: Volume 1, Issue 85
Archive-name: mx2v230/part05
#!/bin/sh
# this is part 5 of a multipart archive
# do not concatenate these parts, unpack them in order with /bin/sh
# file NETWORK.MOD continued
#
CurArch=5
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' >> NETWORK.MOD
XEND RDMediaCh ;
X
XPROCEDURE RDBPB ( 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 gotbpb[device-devicestart]:=FALSE; gotmediach[device-devicestart]:=FALSE END;
X(* gotbpb[device-devicestart]:=FALSE; (* test *) *)
X IF (NOT gotbpb[device-devicestart]) THEN
X IF getfromremote(rdbpbreq,rdbpbconf,nframe1) THEN
X gotbpb[device-devicestart]:=TRUE;
X bpbptr:=ADR(nframe1.info);
X nbpbptr:=ADR(NetworkBPB[device-devicestart]);
X FOR i3:=0 TO TSIZE(BPB)-1 DO
X nbpbptr^[i3]:=bpbptr^[i3];
X END;
X resetnewdisk;
X SETREG(D0,ADR(NetworkBPB[device-devicestart])); (* D0 returns address of the BPB *)
X ELSE
X SETREG(D0,0);
X END;
X ELSE
X SETREG(D0,ADR(NetworkBPB[device-devicestart])); (* D0 returns address of the BPB *)
X END;
X IF networkerror THEN C.sendreset:=TRUE END; (* send network reset to remote cpu *)
X ELSE (* not NETWORK *)
X SaveHDBPB(device) ;
X END ;
X CODE(MOVEMINC,RESTREGS) ; (* Restore registers from stack *)
XEND RDBPB ;
X
XPROCEDURE resetnewdisk;
XBEGIN
X SuperExec(gettime);
X timestart1:=clock;
X timefortimeout1:=timestart1;
X IncTime(timefortimeout1,2);
XEND resetnewdisk;
X
XPROCEDURE newdisk(): BOOLEAN;
XBEGIN
X SuperExec(gettime);
X timeouttime1:=clock;
X SETREG(0,timeouttime1);
X CODE(0280H,0,0FFFFH);
X timeouttime1:=LONGCARD(REGISTER(0));
X IF timeouttime1>timefortimeout1 THEN
X resetnewdisk;
X RETURN TRUE;
X END;
X RETURN FALSE;
XEND newdisk;
X
X(* ----------------------------------------------------------------------- *)
X
XPROCEDURE Initialise (port: Device) : BOOLEAN ;
X(* returns TRUE if NETWORK is to be installed *)
XBEGIN
X CODE(3f3cH,0017H,4e4eH,548fH); (* gettime *)
X CODE(2f00H,3f3cH,0016H,4e4eH,5c8fH); (* settime *)
X IF NOT installed THEN
X SuperExec(PROC(setcontrol)); (* set address of global control record *)
X END;
X IF port=HSS THEN
X rbptr:=IORec(MIDI);
X ELSE
X rbptr:=IORec(RS232);
X END;
X rbptr^.ibuf:=ADR(rbuffer);
X rbptr^.ibufsize:=1024;
X C.magic:=USER;
X C.remotedrive:=0;
X framesize:=TSIZE(frame);
X recframesize:=framesize;
X sndframesize:=framesize;
X sframe.user:=USER;
X R:=0;
X RETURN TRUE;
XEND Initialise ;
X
X(*$P- *) (* set vector to control record *)
XPROCEDURE setcontrol;
XBEGIN
X IF Mptr#USER THEN
X C.drivemap:=DriveMap();
X Dptr:=C.drivemap;
X END;
X C.drivemap:=Dptr;
X Mptr:=USER;
X CODE(RTS);
XEND setcontrol;
X
XPROCEDURE nrecframe;
XBEGIN
X IF C.networkactive THEN
X WHILE (BConStat(netdevice)) AND (NOT framebufferfull) DO
X recchar := BConIn(netdevice);
X IF (CHAR(recchar)=SYN) AND (NOT gotframe) THEN
X gotframe:=TRUE; (* got sync char from data *)
X charcount:=0;
X END;
X IF (charcount=1) AND ((CHAR(recchar)#STX) AND (CHAR(recchar)#SOH)) THEN
X gotframe:=FALSE; (* false start try again *)
X charcount:=0;
X END;
X IF (charcount=1) AND (CHAR(recchar)=STX) THEN
X recframesize:=SIZEframe;
X END;
X IF (charcount=1) AND (CHAR(recchar)=SOH) THEN
X recframesize:=SIZEframecmd;
X END;
X IF gotframe THEN (* put data in buffer *)
X rframeptr^[charcount]:=BYTE(recchar);
X INC(charcount);
X IF charcount=recframesize THEN (* got full frame *)
X gotframe := FALSE;
X IF trace THEN BConOut(CON,"^") END;
X IF recframesize=SIZEframecmd THEN
X rframe.user:=framecmdptr^.user;
X rframe.cksum:=framecmdptr^.cksum;
X END;
X framebufferfull := TRUE;
X END;
X END;
X END; (* WHILE *)
X END;
XEND nrecframe;
X
X(* The following compiler directive stops the compiler from generating the
X normal Modula-2 entry/exit code for the next procedure. This is needed as
X this routine is called in supervisor mode by the BIOS function to install
X the BIOS vectors. *)
X(*$P- Stop entry/exit code for next procedure *)
XPROCEDURE InstallVectors ;
XBEGIN
X (* First save the current hard disk vectors *)
X SaveHDBPB := CBPBProc(HDBPB) ;
X SaveHDRWAbs := CRWAbsProc(HDRWAbs) ;
X SaveHDMediaCh := CMediaChProc(HDMediaCh) ;
X (* Now set the BIOS vectors to our routines *)
X HDBPB := ADDRESS(RDBPB) ;
X HDRWAbs := ADDRESS(RDRWAbs) ;
X HDMediaCh := ADDRESS(RDMediaCh) ;
X drvnr:=2;
X WHILE drvnr IN DriveBits DO
X INC(drvnr);
X END; (* while *)
X INC(drvnr);
X devicestart:=drvnr;
X DriveA:=drvnr;
X DriveF:=drvnr+5;
X INCL(DriveBits,drvnr) ; (* set new drive A *)
X INCL(DriveBits,drvnr+1) ; (* set new drive B *)
X INCL(DriveBits,drvnr+2) ; (* set new drive C *)
X INCL(DriveBits,drvnr+3) ; (* set new drive D *)
X INCL(DriveBits,drvnr+4) ; (* set new drive E *)
X INCL(DriveBits,drvnr+5) ; (* set new drive F *)
X networkconnect := FALSE;
X gotframe := FALSE;
X framebufferfull := FALSE;
X charcount:=0;
X SIZEframe:=TSIZE(frame);
X SIZEframecmd:=TSIZE(framecmd);
X
X rframeptr := ADR(rframe);
X framecmdptr:=ADR(rframe);
X sframeptr := ADR(sframe);
X CODE(RTS) ; (* code to return to calling BIOS function *)
XEND InstallVectors ;
X
XPROCEDURE waitcts(what: BOOLEAN); (* wait for cleartosend state *)
XBEGIN
X IF what THEN
X REPEAT
X nrecframe;
X Nwait(event);
X HandleEvents();
X IF R>retry THEN
X networkerror:=TRUE;
X RETURN; (* trouble *)
X END;
X UNTIL cleartosend;
X RETURN;
X ELSE
X LOOP
X nrecframe;
X Nwait(event);
X IF (NOT cleartosend) THEN EXIT END;
X HandleEvents();
X IF R>retry THEN
X networkerror:=TRUE;
X RETURN; (* trouble *)
X END;
X END; (* loop *)
X IF trace THEN BConOut(CON,"N") END;
X HandleEvents();
X END;
XEND waitcts;
X
X(* request for data from remote hosts disk drives and system *)
X(* what wanted in command, the correct reply in reply, data in f *)
XPROCEDURE getfromremote(command, reply: DataKind; VAR f: frame): BOOLEAN;
XBEGIN
X IF (NOT C.networkactive) THEN RETURN FALSE END; (* error *)
X networkerror:=FALSE;
X R:=0;
X StartTimer;
X IF trace THEN BConOut(CON,"A") END;
X f.kind:=data;
X f.cmd:=command;
X waitcts(TRUE);
X IF networkerror THEN RETURN FALSE END;
X IF trace THEN BConOut(CON,"B") END;
X SFRAME:=f;
X requesttosend:=TRUE;
X waitcts(FALSE);
X IF networkerror THEN RETURN FALSE END;
X IF trace THEN BConOut(CON,"C") END;
X REPEAT
X nrecframe;
X Nwait(event);
X HandleEvents();
X IF R>retry THEN networkerror:=TRUE END;
X IF networkerror THEN RETURN FALSE END;
X UNTIL framewaiting AND (RFRAME.cmd=reply);
X IF trace THEN BConOut(CON,"D") END;
X f:=RFRAME;
X f.rw:=5;
X framewaiting:=FALSE;
X sendtoremote(ack,reply,f); (* send ack for reply *)
X IF networkerror THEN RETURN FALSE END;
X IF trace THEN BConOut(CON,"Z") END;
X RETURN TRUE;
XEND getfromremote;
X
XPROCEDURE sendtoremote(type: FrameKind; command: DataKind;VAR f: frame);
XBEGIN
X IF trace THEN BConOut(CON,"T") END;
X f.kind:=type;
X f.cmd:=command;
X IF debug THEN cleartosend:=TRUE END; (* so we can send in loop *)
X waitcts(TRUE);
X IF trace THEN BConOut(CON,"1") END;
X SFRAME:=f;
X requesttosend:=TRUE;
X waitcts(FALSE);
X IF trace THEN BConOut(CON,"2") END;
X IF SFRAME.kind=ack THEN cleartosend:=TRUE END;
XEND sendtoremote;
X
XPROCEDURE senddata;
XBEGIN
X SFRAME.seq:=C.nextframetosend;
X SFRAME.ack:=1-C.frameexpected;
X sendf(SFRAME);
X IF (SFRAME.kind#ack) AND (SFRAME.kind#resetreq) THEN
X StartTimer; (* set timer to wait for frame ack from remote host *)
X END;
XEND senddata;
X
X(*$P+ *)
XPROCEDURE sendf(VAR f: frame);
XBEGIN
X sframe:=f;
X sframe.cksum:=0;
X 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
X sndframesize:=SIZEframe;
X sframe.syn := SYN ;
X sframe.stx := STX ;
X sframe.user := USER ;
X shortframe:=FALSE;
X IF trace THEN BConOut(CON,":") END;
X ELSE
X sndframesize:=SIZEframecmd;
X sframe.syn := SYN ;
X sframe.stx := SOH ;
X framecmdptr1:=ADR(sframe);
X framecmdptr1^.user := USER ;
X shortframe:=TRUE;
X IF trace THEN BConOut(CON,".") END;
X END;
X FOR i1:=0 TO sndframesize-5 DO (* compute checksum *)
X sframe.cksum:=sframe.cksum+CARDINAL(sframeptr^[i1])
X END;
X IF shortframe THEN framecmdptr1^.cksum:=sframe.cksum END;
X FOR i1:=0 TO sndframesize-1 DO (* send frame *)
X REPEAT
X nrecframe;
X UNTIL BCosStat(netdevice);
X BConOut(netdevice,CHAR(sframeptr^[i1]));
X END;
XEND sendf;
X
X(*$P- *)
XPROCEDURE gettime;
XBEGIN
X clock:=hz200 DIV 200;
X CODE(RTS);
XEND gettime;
X(*$P+ *)
X
XPROCEDURE getf(VAR f: frame);
XBEGIN
X f:=rframe;
X framebufferfull:=FALSE;
XEND getf;
X
XPROCEDURE StartTimer;
XBEGIN
X SuperExec(gettime);
X timestart:=clock; (* set to time in seconds *)
X timer:=TRUE; (* test *)
X timefortimeout:=timestart;
X IncTime(timefortimeout,2);
XEND StartTimer;
X
XPROCEDURE IncTime(VAR t : LONGCARD; c: CARDINAL);
XBEGIN
X IF c<1 THEN RETURN END;
X t:=t+LONGCARD(c);
XEND IncTime;
X
XPROCEDURE TimeOut(): BOOLEAN;
XBEGIN
X IF (NOT timer) THEN RETURN FALSE END;
X SuperExec(gettime);
X timeouttime:=clock;
X SETREG(0,timeouttime);
X CODE(0280H,0,0FFFFH);
X timeouttime:=LONGCARD(REGISTER(0));
X IF timeouttime>timefortimeout THEN
X StartTimer;
X RETURN TRUE;
X END;
X RETURN FALSE;
XEND TimeOut;
X
XPROCEDURE Nwait(VAR e: evtype);
XBEGIN
X
X IF requesttosend AND cleartosend THEN
X e:=hostready;
X requesttosend:=FALSE;
X cleartosend:=FALSE;
X RETURN;
X END;
X
X IF C.sendreset THEN
X e:=reset;
X END;
X
X IF framebufferfull THEN
X cksum:=0;
X FOR i2:=0 TO recframesize-5 DO
X cksum:=cksum+CARDINAL(rframeptr^[i2])
X END;
X IF (cksum=rframe.cksum) THEN
X e:=framearrival;
X INC(R);
X ELSE
X e:=cksumerr;
X framebufferfull:=FALSE;
X IF trace THEN BConOut(CON,"U") END;
X END;
X RETURN;
X END;
X nrecframe;
X IF TimeOut() THEN
X e:=timeout;
X INC(R);
X END; (* so sorry no frame ack *)
XEND Nwait;
X
XPROCEDURE ToHost(VAR f: frame);
XBEGIN
X IF trace THEN BConOut(CON,"H") END;
X IF f.kind=callreq THEN
X framewaiting:=FALSE;
X RETURN;
X END;
X IF f.kind=clearreq THEN
X framewaiting:=FALSE;
X RETURN;
X END;
X IF f.kind=diag THEN
X framewaiting:=FALSE;
X RETURN;
X END;
X IF f.kind=data THEN
X IF f.cmd=rdmediareq THEN
X IF trace THEN BConOut(CON,"M") END;
X framewaiting:=FALSE;
X nframe2.d0:=LONGCARD(MediaChange(CARDINAL(f.d0)));
X sendtoremote(data,rdmediaconf,nframe2);
X RETURN;
X END;
X IF f.cmd=rdbpbreq THEN
X IF trace THEN BConOut(CON,"P") END;
X framewaiting:=FALSE;
X nframe2.d0:=LONGCARD(GetBPB(CARDINAL(f.d0)));
X bpbptr:=ADDRESS(nframe2.d0);
X nbpbptr:=ADR(nframe2.info);
X FOR i:=0 TO TSIZE(BPB)-1 DO
X nbpbptr^[i]:=bpbptr^[i];
X END;
X sendtoremote(data,rdbpbconf,nframe2);
X RETURN;
X END;
X IF f.cmd=rdrwabsreq THEN
X IF trace THEN BConOut(CON,"W") END;
X framewaiting:=FALSE;
X nframe2.d0:=LONGCARD(RWAbs(RW(f.rw),ADR(f.info),1,f.recno,
X CARDINAL(f.d0)));
X IF (f.rw=0) OR (f.rw=2) THEN
X nframe2.rw:=f.rw;
X nframe2.info:=f.info; (* if rec get buffer to send *)
X END;
X sendtoremote(data,rdrwabsconf,nframe2);
X RETURN;
X END;
X END;
XEND ToHost;
X
XPROCEDURE HandleEvents();
XBEGIN
X IF event=hostready THEN
X event:=nothing;
X IF trace THEN BConOut(CON,"S") END;
X senddata;
X END;
X
X IF event=reset THEN
X IF trace THEN BConOut(CON,"I") END;
X charcount:=0;
X R:=0;
X gotframe:=FALSE;
X framebufferfull:=FALSE;
X FOR d:=0 TO 5 DO
X gotmediach[d]:=FALSE;
X gotbpb[d]:=FALSE;
X END;
X C.nextframetosend:=0;
X C.frameexpected:=0;
X cleartosend:=TRUE;
X requesttosend:=FALSE;
X framewaiting:=FALSE;
X timer:=FALSE;
X C.sendreset:=FALSE;
X event:=nothing;
X SFRAME.kind:=resetreq;
X senddata;
X END;
X
X IF event=framearrival THEN
X event:=nothing;
X
X IF (rframe.kind=ack) OR (rframe.kind=resetreq) THEN
X framewaiting:=FALSE
X END;
X IF trace AND (NOT framewaiting) THEN BConOut(CON,"F") END;
X
X IF (NOT framewaiting) THEN getf(RFRAME) END;
X framebufferfull:=FALSE;
X
X IF (RFRAME.ack=C.nextframetosend) OR debug THEN
X IF trace THEN BConOut(CON,"K") END;
X cleartosend:=TRUE;
X StartTimer;
X R:=0;
X timer:=FALSE;
X inc(C.nextframetosend);
X END;
X
X IF (RFRAME.seq=C.frameexpected) OR debug THEN
X IF trace THEN BConOut(CON,"E") END;
X IF RFRAME.kind#ack THEN (* try to exec command *)
X inc(C.frameexpected);
X framewaiting:=TRUE;
X R:=0;
X ToHost(RFRAME);
X END;
X END;
X IF RFRAME.kind=resetreq THEN
X IF trace THEN BConOut(CON,"*") END;
X charcount:=0;
X gotframe:=FALSE;
X framebufferfull:=FALSE;
X C.nextframetosend:=0;
X C.frameexpected:=0;
X FOR d:=0 TO 5 DO
X gotmediach[d]:=FALSE;
X gotbpb[d]:=FALSE;
X END;
X cleartosend:=TRUE;
X requesttosend:=FALSE;
X framewaiting:=FALSE;
X timer:=FALSE;
X C.sendreset:=FALSE;
X event:=nothing;
X BConOut(CON,BEL);
X BConOut(CON,BEL);
X END;
X END;
X
X SFRAME.seq:=C.nextframetosend;
X SFRAME.ack:=1-C.frameexpected;
X
X IF event=timeout THEN
X event:=nothing;
X IF trace THEN BConOut(CON,"R") END;
X sendf(SFRAME);
X framewaiting:=FALSE;
X END;
XEND HandleEvents;
X
XPROCEDURE recframe;
XBEGIN
X nrecframe;
X Nwait(event);
X HandleEvents();
XEND recframe;
X
XPROCEDURE initnetwork(port: Device);
XBEGIN
X netdevice:=port;
X IF Initialise(port) THEN
X
X charcount:=0;
X gotframe:=FALSE;
X framebufferfull:=FALSE;
X C.nextframetosend:=0;
X C.frameexpected:=0;
X FOR d:=0 TO 5 DO
X gotmediach[d]:=FALSE;
X gotbpb[d]:=FALSE;
X END;
X cleartosend:=TRUE;
X requesttosend:=FALSE;
X framewaiting:=FALSE;
X timer:=FALSE;
X C.sendreset:=FALSE;
X event:=nothing;
X C.networkactive:=TRUE;
X IF NOT installed THEN
X SuperExec(PROC(InstallVectors)) ; (* install the NETWORK *)
X installed:=TRUE;
X END;
X END ;
XEND initnetwork;
X
XPROCEDURE networkoff;
XBEGIN
X C.networkactive:=FALSE;
XEND networkoff;
X
XPROCEDURE networkon;
XBEGIN
X C.networkactive:=TRUE;
XEND networkon;
X
XBEGIN
XEND NETWORK.
SHAR_EOF
chmod 0600 NETWORK.MOD || echo "restore of NETWORK.MOD fails"
sed 's/^X//' << 'SHAR_EOF' > NEWSYS.DEF &&
X
X(* Copyright 1987 fred brooks LogicTek *)
X(* *)
X(* *)
X(* 1.0.0 First Release 12/8/87-FGB *)
X(* 1.0.1 Changed to trap #9 because of possible conflict with *)
X(* JSM2 coroutines 12/9/87-FGB *)
X(* *)
X
XDEFINITION MODULE NEWSYS;
XFROM SYSTEM IMPORT ADDRESS;
X
XTYPE PROCESS = ADDRESS;
XCONST TRAP = 0A4H; (* trap 9 adr used for TRANSFER and
X IOTRANSFER *)
X
XPROCEDURE NEWPROCESS(processProc : PROC;
X workspace : ADDRESS;
X worksize : LONGCARD;
X VAR process : ADDRESS);
X
XPROCEDURE TRANSFER(VAR p1,p2: ADDRESS);
X
XPROCEDURE IOTRANSFER(VAR p1,p2: ADDRESS; device: ADDRESS);
X
XEND NEWSYS.
SHAR_EOF
chmod 0600 NEWSYS.DEF || echo "restore of NEWSYS.DEF fails"
sed 's/^X//' << 'SHAR_EOF' > NEWSYS.MOD &&
X
X(* Copyright 1987 fred brooks LogicTek *)
X(* *)
X(* *)
X(* 1.0.0 First Release 12/8/87-FGB *)
X(* 1.0.1 Changed to trap #9 because of possible conflict with *)
X(* JSM2 coroutines 12/9/87-FGB *)
X(* *)
X
XIMPLEMENTATION MODULE NEWSYS; (*$S-,$T- *)
XFROM SYSTEM IMPORT ADDRESS,CODE,SETREG,REGISTER,ADR;
X
XFROM GEMDOS IMPORT Super,Alloc,Free;
X
XTYPE trappointer = POINTER TO PROC;
X processpointer = POINTER TO ADDRESS;
XTYPE iotype = RECORD
X p1 : processpointer;
X p2 : processpointer;
X device : ADDRESS;
X END;
XVAR pc,ssv : ADDRESS;
X io1,io2 : processpointer;
X sr,function : CARDINAL;
X iotranspointer : iotype;
X trap : trappointer;
X pr1,pr2,wsp : ADDRESS;
X n : LONGCARD;
X init : BOOLEAN;
X
XPROCEDURE NEWPROCESS(processProc : PROC;
X workspace : ADDRESS;
X worksize : LONGCARD;
X VAR process : ADDRESS);
XBEGIN
X IF NOT init THEN
X INITPROCESSES;
X END;
X workspace:=workspace+ADDRESS(worksize);
X SETREG(6,ADDRESS(processProc));
X SETREG(8,workspace);
X CODE(2106H); (* move.l d6,-(a0) PC *)
X CODE(313cH,0300H); (* move.w $0300,-(a0) CCR *)
X CODE(48e0H,0fffeH); (* movem.l d0-d7/a0-a6,-(a0) *)
X process:=REGISTER(8);
XEND NEWPROCESS;
X
XPROCEDURE TRANSFER(VAR p1,p2: ADDRESS);
XBEGIN (* pass p1 and p2 as the location of these variables *)
X IF NOT init THEN
X INITPROCESSES;
X END;
X SETREG(0,ADR(p2));
X CODE(2f00H); (* move.l d0,-(sp) *)
X SETREG(0,ADR(p1));
X CODE(2f00H); (* move.l d0,-(sp) *)
X CODE(3f3cH,1); (* move.w #1,-(sp) *)
X CODE(4e49H); (* trap #9 *)
X CODE(0dffcH,0,10); (* add.l #10,sp *)
XEND TRANSFER;
X
XPROCEDURE IOTRANSFER(VAR p1,p2: ADDRESS; device: ADDRESS);
XBEGIN (* pass p1 and p2 as the location of these variables *)
X IF NOT init THEN
X INITPROCESSES;
X END;
X SETREG(0,device);
X CODE(2f00H); (* move.l d0,-(sp) *)
X SETREG(0,ADR(p2));
X CODE(2f00H); (* move.l d0,-(sp) *)
X SETREG(0,ADR(p1));
X CODE(2f00H); (* move.l d0,-(sp) *)
X CODE(3f3cH,2); (* move.w #2,-(sp) *)
X CODE(4e49H); (* trap #9 *)
X CODE(0dffcH,0,14); (* add.l #14,sp *)
XEND IOTRANSFER;
X
X(*$P- *)
XPROCEDURE PTRAP;
XBEGIN
X CODE(043374B,2700H); (* disable ints *)
X CODE(48e7H,0fffeH); (* save regs movem *)
X CODE(306fH,60); (* move.w 60(a7),a0 get sr *)
X sr:=CARDINAL(REGISTER(8));
X IF sr>3fffH THEN (* called from supermode, not valid *)
X CODE(4cdfH,7fffH); (* restore regs movem *)
X CODE(4e73H); (* rte go back to where we came from *)
X END;
X
X CODE(4e69H); (* move.l usp,a1 *)
X CODE(3069H,0); (* move.w 0(a1),a0 *)
X function:=CARDINAL(REGISTER(8));
X CODE(4e69H); (* move.l usp,a1 *)
X CODE(2069H,2); (* move.l 2(a1),a0 *)
X iotranspointer.p1:=REGISTER(8);
X CODE(4e69H); (* move.l usp,a1 *)
X CODE(2069H,6); (* move.l 6(a1),a0 *)
X iotranspointer.p2:=REGISTER(8);
X CODE(4e69H); (* move.l usp,a1 *)
X CODE(2069H,10); (* move.l 10(a1),a0 *)
X iotranspointer.device:=REGISTER(8);
X
X CASE function OF
X 1 : CODE(4e68H); (* move.l usp,a0 TRANSFER *) (* SAVE *)
X CODE(0dffcH,0,42H); (* add.l #66,sp *)
X CODE(2127H); (* move.l -(sp),-(a0) D0 *)
X CODE(2127H); (* move.l -(sp),-(a0) D1 *)
X CODE(2127H); (* move.l -(sp),-(a0) D2 *)
X CODE(2127H); (* move.l -(sp),-(a0) D3 *)
X CODE(2127H); (* move.l -(sp),-(a0) D4 *)
X CODE(2127H); (* move.l -(sp),-(a0) D5 *)
X CODE(2127H); (* move.l -(sp),-(a0) D6 *)
X CODE(2127H); (* move.l -(sp),-(a0) D7 *)
X CODE(2127H); (* move.l -(sp),-(a0) A0 *)
X CODE(2127H); (* move.l -(sp),-(a0) A1 *)
X CODE(2127H); (* move.l -(sp),-(a0) A2 *)
X CODE(2127H); (* move.l -(sp),-(a0) A3 *)
X CODE(2127H); (* move.l -(sp),-(a0) A4 *)
X CODE(2127H); (* move.l -(sp),-(a0) A5 *)
X CODE(2127H); (* move.l -(sp),-(a0) A6 *)
X CODE(3127H); (* move.w -(sp),-(a0) SR *)
X CODE(2127H); (* move.l -(sp),-(a0) PC *)
X iotranspointer.p1^:=REGISTER(8); (* set p1 to process *)
X
X SETREG(8,iotranspointer.p2^); (* load p2 to a0 RESTORE *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ D0 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ D1 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ D2 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ D3 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ D4 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ D5 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ D6 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ D7 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ A0 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ A1 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ A2 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ A3 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ A4 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ A5 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ A6 *)
X CODE(3ed8H); (* move.w (a0)+,(sp)+ SR *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ PC *)
X CODE(9ffcH,0,42H); (* sub.l #66,sp *)
X CODE(4e60H); (* move.l a0,usp *)
X CODE(4cdfH,7fffH); (* restore regs movem *)
X CODE(4e73H); | (* rte *)
X
X 2 : CODE(4e68H); (* move.l usp,a0 IOTRANSFER *) (* SAVE *)
X CODE(0dffcH,0,42H); (* add.l #66,sp *)
X CODE(2127H); (* move.l -(sp),-(a0) D0 *)
X CODE(2127H); (* move.l -(sp),-(a0) D1 *)
X CODE(2127H); (* move.l -(sp),-(a0) D2 *)
X CODE(2127H); (* move.l -(sp),-(a0) D3 *)
X CODE(2127H); (* move.l -(sp),-(a0) D4 *)
X CODE(2127H); (* move.l -(sp),-(a0) D5 *)
X CODE(2127H); (* move.l -(sp),-(a0) D6 *)
X CODE(2127H); (* move.l -(sp),-(a0) D7 *)
X CODE(2127H); (* move.l -(sp),-(a0) A0 *)
X CODE(2127H); (* move.l -(sp),-(a0) A1 *)
X CODE(2127H); (* move.l -(sp),-(a0) A2 *)
X CODE(2127H); (* move.l -(sp),-(a0) A3 *)
X CODE(2127H); (* move.l -(sp),-(a0) A4 *)
X CODE(2127H); (* move.l -(sp),-(a0) A5 *)
X CODE(2127H); (* move.l -(sp),-(a0) A6 *)
X CODE(3127H); (* move.w -(sp),-(a0) SR *)
X CODE(2127H); (* move.l -(sp),-(a0) PC *)
X iotranspointer.p1^:=REGISTER(8); (* set p1 to process *)
X io1:=iotranspointer.p1;
X
X io2:=iotranspointer.p2;
X SETREG(8,iotranspointer.p2^); (* load p2 to a0 RESTORE *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ D0 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ D1 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ D2 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ D3 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ D4 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ D5 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ D6 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ D7 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ A0 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ A1 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ A2 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ A3 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ A4 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ A5 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ A6 *)
X CODE(3ed8H); (* move.w (a0)+,(sp)+ SR *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ PC *)
X CODE(9ffcH,0,42H); (* sub.l #66,sp *)
X CODE(4e60H); (* move.l a0,usp *)
X trap:=trappointer(iotranspointer.device); (* TRAP ADR *)
X trap^:=ITRAP; (* set trap to IOTRANSFER int code *)
X CODE(4cdfH,7fffH); (* restore regs movem *)
X CODE(4e73H); | (* rte *)
X END;
X
X CODE(4cdfH,7fffH); (* restore regs movem *)
X CODE(4e73H); (* rte *)
XEND PTRAP;
X(*$P+ *)
X
X(*$P- *)
XPROCEDURE ITRAP;
XBEGIN
X CODE(043374B,2700H); (* disable ints *)
X CODE(48e7H,0fffeH); (* save regs movem *)
X CODE(4e68H); (* move.l usp,a0 TRANSFER *) (* SAVE *)
X CODE(0dffcH,0,42H); (* add.l #66,sp *)
X CODE(2127H); (* move.l -(sp),-(a0) D0 *)
X CODE(2127H); (* move.l -(sp),-(a0) D1 *)
X CODE(2127H); (* move.l -(sp),-(a0) D2 *)
X CODE(2127H); (* move.l -(sp),-(a0) D3 *)
X CODE(2127H); (* move.l -(sp),-(a0) D4 *)
X CODE(2127H); (* move.l -(sp),-(a0) D5 *)
X CODE(2127H); (* move.l -(sp),-(a0) D6 *)
X CODE(2127H); (* move.l -(sp),-(a0) D7 *)
X CODE(2127H); (* move.l -(sp),-(a0) A0 *)
X CODE(2127H); (* move.l -(sp),-(a0) A1 *)
X CODE(2127H); (* move.l -(sp),-(a0) A2 *)
X CODE(2127H); (* move.l -(sp),-(a0) A3 *)
X CODE(2127H); (* move.l -(sp),-(a0) A4 *)
X CODE(2127H); (* move.l -(sp),-(a0) A5 *)
X CODE(2127H); (* move.l -(sp),-(a0) A6 *)
X CODE(3127H); (* move.w -(sp),-(a0) SR *)
X CODE(2127H); (* move.l -(sp),-(a0) PC *)
X io2^:=REGISTER(8); (* set interrupted process to process *)
X
X SETREG(8,io1^); (* load iotransfer process to a0 RESTORE *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ D0 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ D1 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ D2 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ D3 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ D4 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ D5 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ D6 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ D7 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ A0 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ A1 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ A2 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ A3 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ A4 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ A5 *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ A6 *)
X CODE(3ed8H); (* move.w (a0)+,(sp)+ SR *)
X CODE(2ed8H); (* move.l (a0)+,(sp)+ PC *)
X CODE(9ffcH,0,42H); (* sub.l #66,sp *)
X CODE(4e60H); (* move.l a0,usp *)
X CODE(4cdfH,7fffH); (* restore regs movem *)
X CODE(4e73H); (* rte *)
XEND ITRAP;
X(*$P+ *)
X
XPROCEDURE INITPROCESSES;
XBEGIN
X ssv:=0;
X Super(ssv);
X trap:=trappointer(TRAP);
X trap^:=PTRAP;
X Super(ssv);
X init:=TRUE;
XEND INITPROCESSES;
X
XBEGIN
XEND NEWSYS.
SHAR_EOF
chmod 0600 NEWSYS.MOD || echo "restore of NEWSYS.MOD fails"
sed 's/^X//' << 'SHAR_EOF' > PASSWD.MOD &&
XMODULE PASSWD;
XFROM Terminal IMPORT ReadString,WriteString,WriteLn;
XFROM TermBase IMPORT DoWrite,WriteProc;
XFROM Strings IMPORT String,Compare,CompareResults,Pos,Copy,Concat,
X Length;
XFROM GEMDOS IMPORT OldTerm,Rename,Delete,Open,Close;
XIMPORT TextIO;
XFROM Streams IMPORT StreamKinds,CloseStream;
XFROM GEMX IMPORT BasePageAddress;
XFROM LOGIN IMPORT crypt;
XCONST USERS = 16;
XTYPE sString = ARRAY [0..13] OF CHAR;
X lString = ARRAY [0..64] OF CHAR;
XVAR user,password,prg : ARRAY [0..USERS-1] OF sString;
X path,com : ARRAY [0..USERS-1] OF lString;
X input,clipath : String;
X black : sString;
X i,index,spos,epos : CARDINAL;
X userfound,ok : BOOLEAN;
X normal,noecho : WriteProc;
X result : INTEGER;
X
XPROCEDURE NoEcho(char: CHAR);
XBEGIN
XEND NoEcho;
X
XBEGIN
X Open("passwd",0,result);
X IF result>0 THEN
X ok:=Close(result);
X ELSE
X OldTerm;
X END;
X TextIO.SetDefaultIO("PASSWD",READ,result);
X normal:=DoWrite;
X noecho:=NoEcho;
X FOR i:=0 TO USERS-1 DO (* read in userfile *)
X TextIO.ReadString(input);
X IF input[0]#0c THEN
X spos:=0;
X ok:=Pos(input,":",spos,epos);
X Copy(input,spos,epos-spos,user[i]);
X spos:=epos+1;
X ok:=Pos(input,":",spos,epos);
X Copy(input,spos,epos-spos,password[i]);
X spos:=epos+1;
X ok:=Pos(input,":",spos,epos);
X Copy(input,spos,epos-spos,path[i]);
X spos:=epos+1;
X ok:=Pos(input,":",spos,epos);
X Copy(input,spos,epos-spos,prg[i]);
X spos:=epos+1;
X Copy(input,spos,Length(input)-spos,com[i]);
X END;
X END; (* for *)
X CloseStream(TextIO.in,result);
X CloseStream(TextIO.out,result);
X LOOP
X userfound:=FALSE;
X FOR i:=0 TO CARDINAL(BasePageAddress^.CmdLine[0]) DO
X input[i]:=BasePageAddress^.CmdLine[i+1]; (* read in command line *)
X END;
X input[i+1]:=0c;
X IF input[0]=0c THEN OldTerm END; (* no user exit *)
X FOR i:=0 TO USERS-1 DO
X IF Compare(input,user[i])=Equal THEN
X userfound:=TRUE;
X index:=i;
X END;
X END;
X IF (password[index][0]#0c) OR (NOT userfound) THEN
X WriteString("Old Password: ");
X DoWrite:=noecho;
X ReadString(input);
X DoWrite:=normal;
X WriteLn;
SHAR_EOF
echo "End of part 5, continue with part 6"
echo "6" > s2_seq_.tmp
exit 0