koreth@ssyx.ucsc.edu.ucsc.edu (Steven Grimm) (12/28/88)
Submitted-by: madsen@sask.usask.ca (Jorgen Madsen)
Posting-number: Volume 1, Issue 86
Archive-name: mx2v230/part06
#!/bin/sh
# this is part 6 of a multipart archive
# do not concatenate these parts, unpack them in order with /bin/sh
# file PASSWD.MOD continued
#
CurArch=6
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' >> PASSWD.MOD
X black:=user[index];
X crypt(input,black);
X IF (Compare(black,password[index])=Equal) AND userfound THEN
X EXIT;
X END;
X END;
X IF (password[index][0]=0c) AND userfound THEN EXIT END;
X WriteString("Incorrect Password not changed!");
X WriteLn;
X OldTerm;
X END; (* loop *)
X REPEAT
X WriteString("New Password: ");
X DoWrite:=noecho;
X ReadString(password[index]);
X DoWrite:=normal;
X WriteLn;
X IF Length(password[index])<4 THEN
X WriteString("Password too short. Please use a longer password.");
X WriteLn;
X END;
X UNTIL (Length(password[index])>=4);
X black:=user[index];
X crypt(password[index],black);
X password[index]:=black;
X ok:=Delete("passwd.old");
X Rename("passwd","passwd.old");
X ok:=Delete("passwd");
X TextIO.SetDefaultIO("PASSWD",READWRITE,result);
X FOR i:=0 TO USERS-1 DO (* Write passwd file *)
X IF user[i][0]#0c THEN
X TextIO.WriteString(user[i]);
X TextIO.Write(':');
X TextIO.WriteString(password[i]);
X TextIO.Write(':');
X TextIO.WriteString(path[i]);
X TextIO.Write(':');
X TextIO.WriteString(prg[i]);
X TextIO.Write(':');
X TextIO.WriteString(com[i]);
X TextIO.WriteLn;
X END;
X END; (* for *)
X CloseStream(TextIO.in,result);
X CloseStream(TextIO.out,result);
X OldTerm;
XEND PASSWD.
X
SHAR_EOF
chmod 0600 PASSWD.MOD || echo "restore of PASSWD.MOD fails"
sed 's/^X//' << 'SHAR_EOF' > PIPE.DEF &&
X
X(* Copyright 1987 fred brooks LogicTek *)
X(* *)
X(* *)
X(* First Release 12/8/87-FGB *)
X(* Correct Bad error in PipeOpen causing pipe to be closed if *)
X(* this routine is called 12/14/87-FGB *)
X(* *)
X
XDEFINITION MODULE PIPE;
XFROM SYSTEM IMPORT BYTE,WORD,LONGWORD;
X
XPROCEDURE OpenPipe(pipeName: ARRAY OF CHAR): LONGCARD; (* return pipe id *)
XPROCEDURE IsReadable(pipeid: LONGCARD): BOOLEAN;
XPROCEDURE IsWriteable(pipeid: LONGCARD): BOOLEAN;
XPROCEDURE ClosePipe(pipeid: LONGCARD);
XPROCEDURE PipeOpen(pipeid: LONGCARD): BOOLEAN;
X
XPROCEDURE PWriteByte(pipeid: LONGCARD; byte: BYTE): BOOLEAN;
XPROCEDURE PWriteWord(pipeid: LONGCARD; word: WORD): BOOLEAN;
XPROCEDURE PWriteLongWord(pipeid: LONGCARD; longword: LONGWORD): BOOLEAN;
X
XPROCEDURE PReadByte(pipeid: LONGCARD; VAR byte: BYTE): BOOLEAN;
XPROCEDURE PReadWord(pipeid: LONGCARD; VAR word: WORD): BOOLEAN;
XPROCEDURE PReadLongWord(pipeid: LONGCARD; VAR longword: LONGWORD): BOOLEAN;
XEND PIPE.
SHAR_EOF
chmod 0600 PIPE.DEF || echo "restore of PIPE.DEF fails"
sed 's/^X//' << 'SHAR_EOF' > PIPE.MOD &&
X
X(* Copyright 1987 fred brooks LogicTek *)
X(* *)
X(* *)
X(* First Release 12/8/87-FGB *)
X(* Correct Bad error in PipeOpen causing pipe to be closed if *)
X(* this routine is called 12/14/87 *)
X(* *)
X
X(*$S-,$T- *)
XIMPLEMENTATION MODULE PIPE [7];
XFROM SYSTEM IMPORT BYTE,WORD,LONGWORD,ADDRESS,TSIZE,ADR;
XFROM ATOMIC IMPORT pipetype,sysvariable,PIPE,pipeptr,buflength;
XFROM SYSCALL IMPORT SysVar;
XFROM Storage IMPORT ALLOCATE,DEALLOCATE;
XFROM Strings IMPORT Assign,Compare,CompareResults;
XFROM TextIO IMPORT WriteString,WriteLn,ReadLn;
XCONST bufend = buflength-1;
XVAR pipe1,pipe : pipeptr;
X junk : BYTE;
X pipespointer : POINTER TO pipetype;
X sysvar : sysvariable;
X I : CARDINAL;
X found : BOOLEAN;
X b : POINTER TO ARRAY [0..1] OF BYTE;
X d : CARDINAL;
X b1 : POINTER TO ARRAY [0..3] OF BYTE;
X newpipeptr : pipeptr;
X
XPROCEDURE PWriteByte(p: LONGCARD; b: BYTE): BOOLEAN;
XBEGIN
X IF NOT PipeOpen(p) THEN RETURN FALSE END;
X pipe:=pipeptr(p);
X IF (NOT (pipe^.cnt < buflength)) THEN RETURN FALSE END;
X deposit(pipe,b);
X RETURN TRUE;
XEND PWriteByte;
X
XPROCEDURE PReadByte(p: LONGCARD; VAR b: BYTE): BOOLEAN;
XBEGIN
X IF NOT PipeOpen(p) THEN RETURN FALSE END;
X pipe:=pipeptr(p);
X IF (NOT (pipe^.cnt > 0)) THEN RETURN FALSE END;
X b:=withdraw(pipe);
X RETURN TRUE;
XEND PReadByte;
X
XPROCEDURE PWriteWord(p: LONGCARD; w: WORD): BOOLEAN;
XBEGIN
X IF NOT PipeOpen(p) THEN RETURN FALSE END;
X pipe:=pipeptr(p);
X IF (NOT (pipe^.cnt < buflength-1)) THEN RETURN FALSE END;
X b:=ADR(w);
X FOR d:=0 TO 1 DO
X deposit(pipe,b^[d]);
X END;
X RETURN TRUE;
XEND PWriteWord;
X
XPROCEDURE PReadWord(p: LONGCARD; VAR w: WORD): BOOLEAN;
XBEGIN
X IF NOT PipeOpen(p) THEN RETURN FALSE END;
X pipe:=pipeptr(p);
X IF (NOT (pipe^.cnt > 1)) THEN RETURN FALSE END;
X b:=ADR(w);
X FOR d:=0 TO 1 DO
X b^[d]:=withdraw(pipe);
X END;
X RETURN TRUE;
XEND PReadWord;
X
XPROCEDURE PWriteLongWord(p: LONGCARD; lw: LONGWORD): BOOLEAN;
XBEGIN
X IF NOT PipeOpen(p) THEN RETURN FALSE END;
X pipe:=pipeptr(p);
X IF (NOT (pipe^.cnt < buflength-3)) THEN RETURN FALSE END;
X b1:=ADR(lw);
X FOR d:=0 TO 3 DO
X deposit(pipe,b1^[d]);
X END;
X RETURN TRUE;
XEND PWriteLongWord;
X
XPROCEDURE PReadLongWord(p: LONGCARD; VAR lw: LONGWORD): BOOLEAN;
XBEGIN
X IF NOT PipeOpen(p) THEN RETURN FALSE END;
X pipe:=pipeptr(p);
X IF (NOT (pipe^.cnt > 3)) THEN RETURN FALSE END;
X b1:=ADR(lw);
X FOR d:=0 TO 3 DO
X b1^[d]:=withdraw(pipe);
X END;
X RETURN TRUE;
XEND PReadLongWord;
X
XPROCEDURE deposit(VAR tpipe: pipeptr; byte: BYTE);
XBEGIN
X IF tpipe^.cnt < buflength THEN
X INC(tpipe^.cnt);
X ELSE
X (* pipe full *)
X RETURN;
X END;
X tpipe^.buf[tpipe^.bufhead]:=byte;
X IF tpipe^.bufhead=bufend THEN
X tpipe^.bufhead:=0;
X ELSE
X INC(tpipe^.bufhead);
X END;
XEND deposit;
X
XPROCEDURE withdraw(VAR tpipe: pipeptr): BYTE;
XBEGIN
X IF tpipe^.cnt > 0 THEN
X DEC(tpipe^.cnt);
X ELSE
X (* pipe EMPTY *)
X RETURN BYTE(0);
X END;
X IF tpipe^.buftail = bufend THEN
X tpipe^.buftail:=0;
X ELSE
X INC(tpipe^.buftail);
X END;
X RETURN tpipe^.buf[tpipe^.buftail];
XEND withdraw;
X
XPROCEDURE OpenPipe(pipeName: ARRAY OF CHAR): LONGCARD;
XBEGIN
X SysVar(sysvar);
X pipespointer:=ADDRESS(sysvar.pipes);
X
X I:=0; (* look for pipe name in system pipe list *)
X found:=FALSE;
X WHILE (I#32) AND (pipespointer^[I]#NIL) DO
X newpipeptr:=pipespointer^[I];
X INC(I);
X IF Compare(pipeName,newpipeptr^.pipename)=Equal THEN
X I:=32;
X found:=TRUE;
X END;
X END;
X
X IF (NOT found) THEN
X ALLOCATE(newpipeptr,LONGCARD(TSIZE(PIPE)));
X Assign(newpipeptr^.pipename,pipeName);
X newpipeptr^.bufhead:=0;
X newpipeptr^.buftail:=bufend;
X newpipeptr^.cnt:=0;
X newpipeptr^.bufsize:=buflength;
X
X (* put address of pipe in system list *)
X I:=0;
X LOOP
X IF I=32 THEN HALT END;
X IF pipespointer^[I]=NIL THEN
X pipespointer^[I]:=newpipeptr;
X EXIT;
X END;
X INC(I);
X END;
X END;
X RETURN LONGCARD(newpipeptr);
XEND OpenPipe;
X
XPROCEDURE ClosePipe(p: LONGCARD);
XVAR pipe : pipeptr;
XBEGIN
X pipe:=pipeptr(p);
X SysVar(sysvar);
X pipespointer:=ADDRESS(sysvar.pipes);
X
X (* find address of pipe in system list *)
X found:=FALSE;
X I:=0;
X LOOP
X IF I=32 THEN EXIT END;
X IF pipespointer^[I]=pipe THEN
X pipespointer^[I]:=NIL;
X found:=TRUE;
X EXIT;
X END;
X INC(I);
X END;
X
X IF found THEN
X DEALLOCATE(pipe,LONGCARD(TSIZE(PIPE)));
X END;
XEND ClosePipe;
X
XPROCEDURE PipeOpen(p: LONGCARD): BOOLEAN;
XVAR pipe : pipeptr;
XBEGIN
X pipe:=pipeptr(p);
X SysVar(sysvar);
X pipespointer:=ADDRESS(sysvar.pipes);
X
X (* find address of pipe in system list *)
X I:=0;
X LOOP
X IF I=32 THEN RETURN FALSE END;
X IF pipespointer^[I]=pipe THEN
X RETURN TRUE;
X END;
X INC(I);
X END;
XEND PipeOpen;
X
XPROCEDURE IsReadable(p: LONGCARD): BOOLEAN;
XBEGIN
X pipe:=pipeptr(p);
X IF pipe^.cnt > 0 THEN
X RETURN TRUE;
X ELSE
X RETURN FALSE;
X END;
XEND IsReadable;
X
XPROCEDURE IsWriteable(p: LONGCARD): BOOLEAN;
XBEGIN
X pipe:=pipeptr(p);
X IF pipe^.cnt < buflength THEN
X RETURN TRUE;
X ELSE
X RETURN FALSE;
X END;
XEND IsWriteable;
X
XBEGIN
XEND PIPE.
SHAR_EOF
chmod 0600 PIPE.MOD || echo "restore of PIPE.MOD fails"
sed 's/^X//' << 'SHAR_EOF' > PS.MOD &&
X(*$T-,$S-,$A+ *)
XMODULE ps;
XFROM SYSCALL IMPORT SysVar,SysDes;
XFROM GEMDOS IMPORT OldTerm,GetTime,GetDate,Alloc,Write;
XFROM GEMX IMPORT BasePageAddress;
XFROM SYSTEM IMPORT CODE,ADDRESS,ADR;
XFROM Terminal IMPORT WriteString,WriteLn;
XFROM XBIOS IMPORT SuperExec;
XFROM ATOMIC IMPORT VERSION,SIGNAL,sysvariable,devicetype;
XFROM Strings IMPORT String,Concat,Copy,Length;
XFROM Conversions IMPORT ConvertToString;
XFROM M2Conversions IMPORT ConvertCardinal,ConvertReal;
XFROM BitStuff IMPORT WAnd,WShr;
XFROM SCANNER IMPORT scinit,nxparm,ltext,etext,bkparm;
XFROM TermBase IMPORT DoWrite,WriteProc;
X
XCONST
X SPACES = " ";
X TITLE1 = " ";
X TITLE2 = " Copyright LogicTek 1987,1988 Fred Brooks ";
X PS1 =
X" current system user total CPU total context CRON";
X PS2 =
X" time date memory memory time switches timer";
X PS3 =
X" Name PID PPID Status Pri Init Time CPU time PORT";
XVAR temp,pstemp : String;
X time,date : CARDINAL;
X membot [432H] : LONGCARD;
X memtop [436H] : LONGCARD;
X hz200 [4baH] : LONGCARD;
X s0,currentprocess : SIGNAL;
X sysvar : sysvariable;
X done,dmode,stmode : BOOLEAN;
X temphz200,topusermem,botusermem,usermemleft,memreserve
X : LONGCARD;
X
X
XPROCEDURE FileWrite(char: CHAR);
XVAR writecount : LONGCARD;
XBEGIN
X writecount:=1;
X Write(1,writecount,ADR(char));
XEND FileWrite;
X
X(*$P- *)
XPROCEDURE showmemory;
XVAR memsize : ADDRESS;
XBEGIN
X topusermem:=memtop;
X botusermem:=membot;
X temphz200:=hz200;
X Alloc(LONGCARD(-1),memsize);
X usermemleft:=LONGCARD(memsize);
X CODE(4e75H); (* rts *)
XEND showmemory;
X(*$P+ *)
X
X(*$P- *)
XPROCEDURE gettick;
XBEGIN
X temphz200:=hz200;
X CODE(4e75H); (* rts *)
XEND gettick;
X(*$P+ *)
X
X
XPROCEDURE FormatTD(time: CARDINAL; date: CARDINAL);
XBEGIN
X ConvertCardinal(CARDINAL(WShr(WAnd(time,63488),11)),2,temp);
X WriteString(temp); (* hour *)
X WriteString(":");
X
X ConvertCardinal(CARDINAL(WShr(WAnd(time,2016),5)),2,temp);
X WriteString(temp); (* minute *)
X WriteString(":");
X
X ConvertCardinal(2*CARDINAL(WAnd(time,31)),2,temp);
X WriteString(temp); (* second *)
X WriteString(" ");
X
X ConvertCardinal(CARDINAL(WShr(WAnd(date,480),5)),2,temp);
X WriteString(temp); (* month *)
X WriteString("/");
X
X ConvertCardinal(CARDINAL(WAnd(date,31)),2,temp);
X WriteString(temp); (* day *)
X WriteString("/");
X
X ConvertCardinal(80+CARDINAL(WShr(WAnd(date,65024),9)),2,temp);
X WriteString(temp); (* year *)
X WriteString(" ");
XEND FormatTD;
X
XPROCEDURE showtime(tick: LONGCARD);
XVAR sec : REAL;
X min,hour : LONGCARD;
XBEGIN
X sec:=FLOAT(tick);
X sec:=sec/200.0;
X min:=TRUNCD(sec) DIV 60;
X hour:=min DIV 60;
X min:=min-(hour*60);
X ConvertToString(hour,10,FALSE,temp,done);
X scinit(ADR(temp),SIZE(temp));
X nxparm;
X ltext(ADR(temp),SIZE(temp));
X WriteString(temp);
X WriteString(":");
X ConvertToString(min,10,FALSE,temp,done);
X scinit(ADR(temp),SIZE(temp));
X nxparm;
X ltext(ADR(temp),SIZE(temp));
X WriteString(temp);
X WriteString(":");
X sec:=sec-FLOAT(min*60)-FLOAT(hour*3600);
X ConvertReal(sec,11,3,temp);
X scinit(ADR(temp),SIZE(temp));
X nxparm;
X ltext(ADR(temp),SIZE(temp));
X WriteString(temp);
XEND showtime;
X
X(* return time in seconds *)
XPROCEDURE converttime(time: CARDINAL): LONGCARD;
XVAR h,m,s : LONGCARD;
XBEGIN
X h:=LONGCARD(WShr(WAnd(time,63488),11)); (* hours *)
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
XBEGIN
X DoWrite:=WriteProc(FileWrite);
X IF BasePageAddress^.CmdLine[2]='z' THEN stmode:=TRUE END;
X SysDes(currentprocess);
X SysVar(sysvar);
X SuperExec(showmemory); (* return memsize *)
X WriteLn;
X WriteString(TITLE1);
X WriteString(VERSION);
X WriteString(TITLE2);
X WriteLn;
X GetTime(time);
X GetDate(date);
X WriteString(PS1);
X WriteLn;
X WriteString(PS2);
X WriteLn;
X WriteString(" ");
X FormatTD(time,date);
X ConvertToString(topusermem,10,FALSE,temp,done);
X Copy(SPACES,0,10-Length(temp),pstemp);
X Concat(temp,pstemp,temp);
X WriteString(temp);
X ConvertToString(usermemleft,10,FALSE,temp,done);
X Copy(SPACES,0,10-Length(temp),pstemp);
X Concat(temp,pstemp,temp);
X WriteString(temp);
X showtime(temphz200-sysvar.slicebegin^);
X WriteString(" ");
X ConvertToString(sysvar.contextswitch^,10,FALSE,temp,done);
X Copy(SPACES,0,14-Length(temp),pstemp);
X Concat(temp,pstemp,temp);
X WriteString(temp);
X IF sysvar.CronActive^ THEN
X WriteString("ACTIVE");
X ELSE
X WriteString("INACTIVE");
X END;
X WriteLn;
X WriteLn;
X WriteString(PS3);
X WriteLn;
X
X s0:=currentprocess;
X REPEAT
X IF s0^.pid#1 THEN
X s0:=s0^.next
X END;
X UNTIL s0^.pid=1;
X REPEAT
X WITH s0^ DO
X IF stmode THEN
X IF wsp=NIL THEN dmode:=TRUE ELSE dmode:=FALSE END;
X ELSE
X IF wsp#NIL THEN dmode:=TRUE ELSE dmode:=FALSE END;
X END;
X IF dmode THEN (* display *)
X WriteString(" ");
X Copy(SPACES,0,15-Length(name),pstemp);
X Concat(name,pstemp,temp);
X WriteString(temp);
X ConvertCardinal(pid,2,temp);
X WriteString(temp);
X WriteString(" ");
X ConvertCardinal(ppid,2,temp);
X WriteString(temp);
X WriteString(" ");
X IF active THEN
X IF ready THEN
X WriteString("Run ");
X ELSE
X WriteString("Ready ");
X END;
X ELSE
X IF wsp=NIL THEN
X WriteString("Inactive");
X ELSE
X WriteString("Sleep ");
X END;
X END;
X ConvertCardinal(pri,2,temp);
X WriteString(temp);
X WriteString(" ");
X FormatTD(time,date);
X showtime(tick);
X WriteString(" ");
X CASE Iport OF
X printer : WriteString("P"); |
X aux : WriteString("A"); |
X con : WriteString("C"); |
X midi : WriteString("M"); |
X null : WriteString("N"); |
X dev0 : WriteString("0"); |
X dev1 : WriteString("1"); |
X dev2 : WriteString("2"); |
X dev3 : WriteString("3"); |
X dev4 : WriteString("4"); |
X dev5 : WriteString("5"); |
X dev6 : WriteString("6"); |
X dev7 : WriteString("7"); |
X END;
X WriteString("/");
X CASE Oport OF
X printer : WriteString("P"); |
X aux : WriteString("A"); |
X con : WriteString("C"); |
X midi : WriteString("M"); |
X null : WriteString("N"); |
X dev0 : WriteString("0"); |
X dev1 : WriteString("1"); |
X dev2 : WriteString("2"); |
X dev3 : WriteString("3"); |
X dev4 : WriteString("4"); |
X dev5 : WriteString("5"); |
X dev6 : WriteString("6"); |
X dev7 : WriteString("7"); |
X END;
X WriteLn;
X END; (* if *)
X END; (* with *)
X s0:=s0^.next;
X UNTIL (s0^.pid=0);
X WriteLn;
X ConvertToString(sysvar.sysmemsize^,10,FALSE,temp,done);
X WriteString(" System Process Memory Remaining ");
X WriteString(temp);
X WriteLn;
X WriteLn;
X OldTerm;
XEND ps.
SHAR_EOF
chmod 0600 PS.MOD || echo "restore of PS.MOD fails"
sed 's/^X//' << 'SHAR_EOF' > REDIR.MOD &&
X
X(* Copyright 1987 fred brooks LogicTek *)
X(* *)
X(* *)
X(* First Release 12/8/87-FGB *)
X(* *)
X
XMODULE redir;
X(*$T- *)
XFROM SYSTEM IMPORT ADDRESS, CODE, REGISTER, SETREG;
XFROM GEMX IMPORT BasePageAddress, BasePageType ;
XFROM GEMDOS IMPORT TermRes;
XFROM XBIOS IMPORT SuperExec;
XVAR cmd,dev,a7,sr,port,oldbios : ADDRESS;
X bios [0b4H] : ADDRESS;
X aline [28H] : ADDRESS;
X gem [88H] : ADDRESS;
X char : CHAR;
X
X(*$P-,$S- *)
XPROCEDURE changedevbios;
XBEGIN
X CODE(48e7H,0fffeH); (* save regs *)
X CODE(306fH,60); (* move.w 60(a7),a0 get sr *)
X sr:=REGISTER(8);
X IF sr<3ffH THEN (* called from user mode *)
X CODE(204fH); (* move.l a7,a0 *)
X a7:=REGISTER(8); (* save ssp *)
X CODE(4e68H,2e48H); (* move.l usp,a0 move.l a0,a7 *)
X CODE(306fH,2); (* move.w 2(a7),a0 *)
X dev:=REGISTER(8);
X CODE(306fH,0); (* move.w 0(a7),a0 *)
X cmd:=REGISTER(8);
X IF (cmd=1) OR (cmd=2) OR (cmd=3) OR (cmd=8) THEN
X IF dev=2 THEN
X dev:=port; (* change to port *)
X SETREG(8,dev);
X CODE(3f48H,2); (* move.w a0,2(a7) set value in stack *)
X END;
X END;
X SETREG(8,a7);
X CODE(2e48H); (* move.l a0,a7 *)
X ELSE (* called from super mode *)
X CODE(306fH,68); (* move.w 68(a7),a0 *)
X dev:=REGISTER(8);
X CODE(306fH,66); (* move.w 66(a7),a0 *)
X cmd:=REGISTER(8);
X IF (cmd=1) OR (cmd=2) OR (cmd=3) OR (cmd=8) THEN
X IF dev=2 THEN
X dev:=port; (* change to port *)
X SETREG(8,dev);
X CODE(3f48H,68); (* move.w a0,68(a7) set value in stack *)
X END;
X END;
X END;
X SETREG(8,oldbios); (* move 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 *)
XEND changedevbios;
X(*$P+,$S+ *)
X
X(*$P-,$S- *)
XPROCEDURE dummyvector;
XBEGIN
X CODE(4e73H); (* rte *)
XEND dummyvector;
X(*$P+,$S+ *)
X
X(*$P-,$S- *)
XPROCEDURE setup;
XBEGIN
X oldbios:=bios;
X bios:=ADDRESS(changedevbios);
X(* aline:=ADDRESS(dummyvector); *)
X gem:=ADDRESS(dummyvector);
X CODE(4e75H); (* RTS *)
XEND setup;
X(*$P+,$S+ *)
X
XBEGIN;
X char:=BasePageAddress^.CmdLine[1];
X IF (char='m') OR (char='M') THEN
X port:=3; (* midi *)
X ELSE
X port:=1; (* aux *)
X END;
X SuperExec(setup);
X WITH BasePageAddress^ DO
X TermRes(CodeLen+BssLen+LONGCARD(CodeBase-ADDRESS(BasePageAddress)),0);
X END;
XEND redir.
SHAR_EOF
chmod 0600 REDIR.MOD || echo "restore of REDIR.MOD fails"
sed 's/^X//' << 'SHAR_EOF' > RUN.MOD &&
X
X(* Copyright 1988 fred brooks LogicTek *)
X(* *)
X(* *)
X(* First Release 3/26/88-FGB *)
X(* *)
X
XMODULE run; (* MX2 program pterm code buffer program *)
XFROM GEMDOS IMPORT Term,Exec,ExecMode;
XFROM GEMX IMPORT BasePageAddress;
XFROM SCANNER IMPORT scinit,nxparm,ltext,etext,bkparm;
XFROM SYSTEM IMPORT ADR,ADDRESS;
XFROM Strings IMPORT String,Length,Pos,Concat;
XVAR i : INTEGER;
X p : CARDINAL;
X ok : BOOLEAN;
X command,name,tail,temp : String;
XBEGIN
X FOR i:=1 TO 79 DO
X command[i-1]:=BasePageAddress^.CmdLine[i];
X END;
X command[ORD(BasePageAddress^.CmdLine[0])]:=CHAR(0);
X scinit(ADR(command),SIZE(command));
X nxparm;
X ltext(ADR(name),SIZE(name));
X nxparm;
X etext(ADR(tail[1]),SIZE(tail));
X bkparm;
X etext(ADR(temp),SIZE(temp));
X tail[0]:=CHAR(Length(temp));
X IF Pos(name,".",0,p) THEN
X Exec(loadExecute,name,tail,"",i);
X ELSE
X temp:=name;
X Concat(name,".prg",name);
X Exec(loadExecute,name,tail,"",i);
X IF i=(-33) THEN
X name:=temp;
X Concat(name,".tos",name);
X Exec(loadExecute,name,tail,"",i);
X END;
X IF i=(-33) THEN
X name:=temp;
X Concat(name,".ttp",name);
X Exec(loadExecute,name,tail,"",i);
X END;
X END;
X ok:=Term(i);
XEND run.
X
SHAR_EOF
chmod 0600 RUN.MOD || echo "restore of RUN.MOD fails"
sed 's/^X//' << 'SHAR_EOF' > SCANNER.DEF &&
X
X(* Copyright 1987 fred brooks LogicTek *)
X(* *)
X(* *)
X(* First Release 12/8/87-FGB *)
X(* *)
X
XDEFINITION MODULE SCANNER;
X
XFROM SYSTEM IMPORT ADDRESS;
X
XTYPE
X modetype = (delimiter,register,translation);
X modes = SET OF modetype;
X scstate =
X RECORD
X return : LONGINT;
X auxreturn : LONGINT;
X disp : CARDINAL;
X prevdisp : CARDINAL;
X delim : ADDRESS;
X delimret : CARDINAL;
X bufadr : ADDRESS;
X buflen : CARDINAL;
X mode : modes;
X END;
X
XVAR state : scstate;
X
XPROCEDURE scinit(bufadr: ADDRESS; buflen: CARDINAL);
XPROCEDURE gtdisp(): CARDINAL;
XPROCEDURE gbdisp(): CARDINAL;
XPROCEDURE stdisp(disp: CARDINAL);
XPROCEDURE nxparm;
XPROCEDURE bkparm;
XPROCEDURE dlim;
XPROCEDURE stmode(mode: modes);
XPROCEDURE char(VAR ch: CHAR);
XPROCEDURE bkchar(VAR ch: CHAR);
XPROCEDURE nxchar(VAR ch: CHAR);
XPROCEDURE onenum;
XPROCEDURE ltext(bufadr: ADDRESS; buflen: CARDINAL);
XPROCEDURE etext(bufadr: ADDRESS; buflen: CARDINAL);
XEND SCANNER.
SHAR_EOF
chmod 0600 SCANNER.DEF || echo "restore of SCANNER.DEF fails"
sed 's/^X//' << 'SHAR_EOF' > SCANNER.MOD &&
X
X(* Copyright 1987 fred brooks LogicTek *)
X(* *)
X(* *)
X(* First Release 12/8/87-FGB *)
X(* *)
X
XIMPLEMENTATION MODULE SCANNER;
X(*$T-,$S-,$A+ *)
XFROM SYSTEM IMPORT ADDRESS,ADR;
X
XTYPE
X charptr = POINTER TO CHAR;
X chset = SET OF CHAR;
X(* internal state record
X scstate =
X RECORD
X return : LONGINT;
X auxreturn : LONGINT;
X disp : CARDINAL;
X prevdisp : CARDINAL;
X delim : ADDRESS;
X delimret : CARDINAL;
X bufadr : ADDRESS;
X buflen : CARDINAL;
X mode : modes;
X END;
X*)
X
XVAR chrptr : charptr;
X cmdline,textline : ARRAY [0..81] OF CHAR;
X ch : CHAR;
X
XCONST alpha = chset{"A".."Z","a".."z"};
X num = chset{"+","-","0".."9"};
X(* Initialize the scanner and pass a buffer to be scanned. Only one buffer
Xmay be processed by the scanner at a time. *)
XPROCEDURE scinit(bufadr: ADDRESS; buflen: CARDINAL);
XBEGIN
X state.return:=0;
X state.auxreturn:=0;
X state.disp:=0;
X state.prevdisp:=0;
X state.delim:=NIL;
X state.bufadr:=bufadr;
X state.buflen:=buflen;
X state.mode:=modes{};
X state.delimret:=0;
XEND scinit;
X
XPROCEDURE gtdisp(): CARDINAL;
XBEGIN
XEND gtdisp;
X
XPROCEDURE gbdisp(): CARDINAL;
XBEGIN
XEND gbdisp;
X
X(* set new value as the current scanner displacement *)
XPROCEDURE stdisp(disp: CARDINAL);
XBEGIN
X state.prevdisp:=state.disp;
X IF bufeol(disp)=(-2) THEN (* past end of line *)
X state.return:=(-2);
X ELSE
X state.prevdisp:=state.disp;
X state.disp:=disp;
X state.return:=0;
X END;
XEND stdisp;
X
XPROCEDURE nxparm;
XVAR i : CARDINAL;
X ch : CHAR;
XBEGIN
X chrptr:=charptr(state.bufadr+ADDRESS(state.disp));
X i:=state.disp;
X LOOP
X IF bufeol(i)<0 THEN
X state.return:=(-2); (* end of line *)
X EXIT;
X END;
X IF NOT delimit(chrptr^) THEN
X state.prevdisp:=state.disp;
X state.disp:=i;
X state.return:=0;
X EXIT;
X END;
X INC(i);
X INC(chrptr);
X END;
XEND nxparm;
X
X(* return 0=not eol, -1=eol, -2=past eol *)
XPROCEDURE bufeol(pos: CARDINAL): INTEGER;
XVAR cptr : charptr;
X eol : BOOLEAN;
X i : CARDINAL;
XBEGIN
X eol:=FALSE;
X i:=0;
X LOOP
X cptr:=charptr(state.bufadr+ADDRESS(i));
X IF i=state.buflen THEN
X EXIT;
X END;
X IF cptr^='$' THEN (* search for " $" sequence *)
X DEC(cptr);
X IF cptr^=' ' THEN
X DEC(i);
X EXIT; (* i = eol *)
X END;
X END;
X INC(i);
X END; (* loop *)
X
X IF (pos=i-1) THEN
X state.delimret:=2;
X RETURN (-1);
X END;
X IF (pos>i-1) THEN
X state.delimret:=2;
X RETURN (-2);
X END;
X RETURN 0;
XEND bufeol;
X
XPROCEDURE delimit(ch: CHAR): BOOLEAN;
XBEGIN
X IF (ch=' ') OR (ch=CHAR(0)) THEN
X state.delimret:=0;
X RETURN TRUE;
X END;
X IF ch=',' THEN
X state.delimret:=1;
X RETURN TRUE;
X END;
X RETURN FALSE;
XEND delimit;
X
XPROCEDURE bkparm;
XBEGIN
X state.disp:=state.prevdisp;
XEND bkparm;
X
XPROCEDURE dlim;
XBEGIN
XEND dlim;
X
XPROCEDURE stmode(mode: modes);
XBEGIN
XEND stmode;
X
XPROCEDURE char(VAR ch: CHAR);
XBEGIN
X state.return:=0;
X chrptr:=charptr(state.bufadr+ADDRESS(state.disp));
X IF chrptr^#CHAR(0) THEN
X IF state.disp<state.buflen-1 THEN
X INC(state.disp);
X ELSE
X state.return:=(-2);
X END;
X ELSE
X state.return:=(-2);
X END;
X ch:=chrptr^;
XEND char;
X
XPROCEDURE bkchar(VAR ch: CHAR);
XBEGIN
X state.return:=0;
X IF state.disp=0 THEN
X state.return:=(-2);
X ch:=CHAR(0);
X RETURN;
X END;
X chrptr:=charptr(state.bufadr+ADDRESS(state.disp-1));
X ch:=chrptr^;
XEND bkchar;
X
XPROCEDURE nxchar(VAR ch: CHAR);
XBEGIN
X state.return:=0;
X chrptr:=charptr(state.bufadr+ADDRESS(state.disp));
X IF chrptr^#CHAR(0) THEN
X IF state.disp<state.buflen-1 THEN
X ELSE
X state.return:=(-2);
X END;
X ELSE
X state.return:=(-2);
X END;
X ch:=chrptr^;
XEND nxchar;
X
XPROCEDURE onenum;
XBEGIN
XEND onenum;
X
XPROCEDURE ltext(bufadr: ADDRESS; buflen: CARDINAL);
XVAR i,j : CARDINAL;
X textbuf : charptr;
XBEGIN
X textbuf:=bufadr;
X j:=0;
X chrptr:=charptr(state.bufadr+ADDRESS(state.disp));
X i:=state.disp;
X state.prevdisp:=state.disp;
X IF delimit(chrptr^) THEN
X textbuf^:=CHAR(0);
X state.return:=(-1);
X RETURN;
X END;
X
X LOOP
X IF bufeol(i)=(-2) THEN (* past eol *)
X state.return:=(-2);
X EXIT;
X END;
X IF NOT delimit(chrptr^) THEN
X IF j<buflen THEN (* stop at end of buffer *)
X textbuf^:=chrptr^;
X END;
X state.disp:=i;
X ELSE
X INC(j);
X IF NOT (j>buflen) THEN
X textbuf^:=CHAR(0);
X END;
X IF bufeol(i)=(-1) THEN (* if eol *)
SHAR_EOF
echo "End of part 6, continue with part 7"
echo "7" > s2_seq_.tmp
exit 0