koreth@ssyx.ucsc.edu.ucsc.edu (Steven Grimm) (12/27/88)
Submitted-by: madsen@sask.usask.ca (Jorgen Madsen)
Posting-number: Volume 1, Issue 83
Archive-name: mx2v230/part03
#!/bin/sh
# this is part 3 of a multipart archive
# do not concatenate these parts, unpack them in order with /bin/sh
# file LOGIN.MOD continued
#
CurArch=3
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' >> LOGIN.MOD
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,SetPath,GetPath,Exec,ExecMode,SetDrv;
XIMPORT TextIO;
XFROM Streams IMPORT StreamKinds,CloseStream;
XFROM SYSTEM IMPORT ADR;
XCONST USERS = 16;
X SEED1 = 3844364602;
X SEED2 = 1561798242;
XTYPE sarray = ARRAY [0..7] OF CHAR;
XVAR user,password,prg : ARRAY [0..USERS-1] OF String;
X path,com : ARRAY [0..USERS-1] OF String;
X input : String;
X black,gulampath : String;
X clipath : String;
X i,j,index,spos,epos : CARDINAL;
X userfound,ok : BOOLEAN;
X normal,noecho : WriteProc;
X result : INTEGER;
X drvmap : LONGCARD;
X
XPROCEDURE NoEcho(char: CHAR);
XBEGIN
XEND NoEcho;
X
XPROCEDURE login;
XBEGIN
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 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; (* for *)
X CloseStream(TextIO.in,result);
X CloseStream(TextIO.out,result);
X input[0]:=33c; input[1]:='e'; input[2]:=0c;
X WriteString(input);
X LOOP
X REPEAT
X userfound:=FALSE;
X WriteLn;
X WriteString("Login: ");
X ReadString(input);
X WriteLn;
X UNTIL input[0]#0c;
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("Password: ");
X DoWrite:=noecho;
X ReadString(input);
X DoWrite:=normal;
X WriteLn;
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 WriteLn;
X WriteString("Login incorrect");
X END; (* loop *)
X GetPath(gulampath,0);
X IF path[index][0]=0c THEN
X GetPath(clipath,0);
X ELSE
X clipath:=path[index];
X IF clipath[0]#'\' THEN
X IF ORD(clipath[0])>60H THEN
X SetDrv(ORD(clipath[0])-61H,drvmap);
X ELSE
X SetDrv(ORD(clipath[0])-41H,drvmap);
X END;
X j:=1;
X REPEAT
X clipath[j-1]:=clipath[j];
X INC(j);
X UNTIL (clipath[j-1]=0c);
X END;
X END;
X IF NOT ((clipath[0]='\') AND (clipath[1]=0c)) THEN
X Concat(clipath,"\",clipath);
X END;
X IF prg[index][0]=0c THEN
X prg[index]:=gulampath;
X IF NOT ((prg[index][0]='\') AND (prg[index][1]=0c)) THEN
X Concat(prg[index],"\",prg[index]);
X END;
X Concat(prg[index],"gulam.prg",prg[index]);
X END;
X ok:=SetPath(clipath);
X input[0]:=33c; input[1]:='f'; input[2]:=0c;
X WriteString(input);
X Exec(loadExecute,prg[index],"","",result);
XEND login;
X
XPROCEDURE crypt(VAR red,crypto: ARRAY OF CHAR);
XVAR seed : ARRAY [0..1] OF LONGCARD;
X chptr : POINTER TO sarray;
X black : CHAR;
XBEGIN
X seed[0]:=SEED1;
X seed[1]:=SEED2;
X chptr:=ADR(seed);
X FOR i:=0 TO 7 DO
X FOR j:=0 TO 7 DO
X chptr^[i]:=CHAR(BITSET(chptr^[i])/BITSET(red[j]));
X chptr^[i]:=CHAR(BITSET(chptr^[i])/BITSET(crypto[j]));
X END;
X black:=CHAR(40H+CARDINAL( BITSET(chptr^[i]) * BITSET(31) ));
X crypto[i]:=black;
X END;
X crypto[8]:=0c;
XEND crypt;
X
XBEGIN
XEND LOGIN.
X
SHAR_EOF
chmod 0600 LOGIN.MOD || echo "restore of LOGIN.MOD fails"
sed 's/^X//' << 'SHAR_EOF' > LP.MOD &&
XMODULE lp;
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]:=1;
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 lp.
SHAR_EOF
chmod 0600 LP.MOD || echo "restore of LP.MOD fails"
sed 's/^X//' << 'SHAR_EOF' > MX2.MOD &&
X(*$T-,$S-,$A+ *)
XMODULE MX2;
X
X(* Copyright 1987,1988 fred brooks LogicTek *)
X(* *)
X(* *)
X(* First Release 12/8/87-FGB *)
X(* Corrected code to match changes in lib modules *)
X(* 1/9/88-FGB *)
X(* Bug in parser converted all text to UPPER case. Fixed *)
X(* 2/27/88-FGB *)
X(* Misc bug fixes. *)
X(* 4/3/88-FGB *)
X(* Remove NETWORK routines from kernel *)
X(* 4/11/88-FGB *)
X(* Remove SP & XMODEM routines from kernel *)
X(* 4/11/88-FGB *)
X(* Remove TRAP15 interface routines 6/9/88-FGB *)
X(* *)
X
X FROM Terminal IMPORT ReadString,WriteString,WriteLn;
X FROM TextIO IMPORT REadString;
X FROM Conversions IMPORT ConvertFromString;
X FROM M2Conversions IMPORT ConvertToInteger,ConvertToAddr;
X FROM BitStuff IMPORT WAnd,WShr;
X FROM GEMDOS IMPORT ExecMode,Exec,Alloc,Free,OldTerm,
X GetPath,GetDrv,GetTime,
X SetPath,SetDrv;
X FROM XBIOS IMPORT SuperExec,IOREC,IORECPTR,SerialDevice,
X IORec,ScreenPhysicalBase;
X FROM BIOS IMPORT Device,BConStat,BConIn,BConOut,BCosStat,
X KBShifts,GetKBShift,KBShiftBits;
X FROM Streams IMPORT Stream,OpenStream,CloseStream,EOS,
X StreamKinds;
X FROM Storage IMPORT CreateHeap;
X FROM SYSTEM IMPORT ADR,ADDRESS,CODE,PROCESS,REGISTER,SETREG;
X
X FROM ATOMIC IMPORT Initsked,MultiEnd,MultiBegin,CronActive,
X InitProcesses,StartProcess,currentprocess,
X TermProcess,SIGNAL,SwapProcess,request,MAGIC,
X command,SleepProcess,WakeupProcess,
X ChangeProcessPriority,CRON,DeviceTable,
X spintenable,spintmask,spint,bpsave,GEMTYPE,
X sysvariable,gemsaveGvec,ROMDATE,OLDDATE,NEWDATE,
X NextPid,VERSION,sysmemsize,devicetype;
X
X FROM SCANNER IMPORT scinit,nxparm,ltext,etext,bkparm,state;
X
X FROM Strings IMPORT Compare,Pos,Length,Concat,CompareResults,String;
X
X
XCONST intnum = 4; (* interrupt number on MFP *)
XTYPE ctype =
X RECORD
X stime : LONGCARD;
X freq : LONGCARD;
X btime : LONGCARD;
X command : String;
X active : BOOLEAN;
X END;
X screen = ARRAY [0..7999] OF LONGCARD;
XVAR
X result,pri,cli1,cli2,clipid,
X spawnpid : INTEGER;
X proc : PROC;
X Oportdevice,Iportdevice : devicetype;
X pc,returnadr,kpc,
X oldikbd,par : ADDRESS;
X gemsave,param : ARRAY [0..15] OF ADDRESS;
X paramstringptr : POINTER TO String;
X sizewsp,temphz200,cronslice,currenttime : LONGCARD;
X cmd,dev,c,a7,SR,tbiosSave : ADDRESS;
X gem [88H] : ADDRESS;
X hz200 [4baH] : LONGCARD;
X termvec [408H] : ADDRESS;
X linea [28H] : ADDRESS;
X gemdos [84H] : ADDRESS;
X gsxgem [88H] : ADDRESS;
X tbios [0b4H] : ADDRESS;
X xbios [0b8H] : ADDRESS;
X linef [2cH] : ADDRESS;
X level2 [68H] : ADDRESS;
X level4 [70H] : ADDRESS;
X shellp [04f6H] : ADDRESS;
X ikbdvec [118H] : PROC;
X OpenCLI,i,bprunning,function,
X time,defaultdrv,requestdrv,sr,drv,
X ksr : CARDINAL;
X cmdstring,temp,name,tail,envstr,pname,
X defaultpath,requestpath,pstemp,initprg : String;
X inuse,done,
X swloaded,caps,reservemem,swapcli,inok,
X outok : BOOLEAN;
X periods,drivemap,HotKey,Hotreturn,kjunk,
X NorMouse,CurMouse,RebootKey,memreserve,
X SYSMEM,cin : LONGCARD;
X crontable : ARRAY [0..15] OF ctype;
X ticktime : LONGINT;
X s0 : SIGNAL;
X sysvar : sysvariable;
X sysvector [144H] : POINTER TO sysvariable;
X Kshift,Hotset,CapsL : KBShifts;
X physcreen : POINTER TO screen;
X screensave : POINTER TO ARRAY [1..2]
X OF screen;
X kbdiorec : IORECPTR;
X ibuf : POINTER TO ARRAY [0..63]
X OF LONGCARD;
X
XCONST
X TDI = " Written in TDI MODULA-2 Version 3.01a ";
X TITLE1 = " ";
X TITLE2 = " Copyright LogicTek 1987,1988 Fred Brooks ";
X CRONFILE = "CRONTAB";
X
X(*$P- *)
XPROCEDURE keytrapstart; (* modify IKBD system vector *)
XBEGIN
X CODE(48e7H,0fffeH); (* save regs movem *)
X CODE(206fH,62); (* move.l 62(a7),a0 get pc *)
X kpc:=REGISTER(8);
X CODE(306fH,60); (* move.w 60(a7),a0 get sr *)
X ksr:=CARDINAL(REGISTER(8));
X SETREG(8,ADDRESS(keytrapend));
X CODE(2f48H,62); (* move new pc to stack *)
X SETREG(8,2700H);
X CODE(3f48H,60); (* move new sr to stack *)
X
X SETREG(8,oldikbd); (* move IKBD 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 keytrapstart;
X(*$P+ *)
X
X(*$P- *)
XPROCEDURE keytrapend; (* check for hotkeys *)
XBEGIN
X CODE(5d8fH); (* subq.l #6,sp *)
X CODE(48e7H,0fffeH); (* save regs movem *)
X
X Hotreturn:=ibuf^[kbdiorec^.ibuftl DIV 4];
X CODE(2f39H,0,4a2H); (* save BIOS pointers *)
X CODE(4b9H,0,2eH,0,4a2H);
X
X IF Hotreturn=RebootKey THEN
X CODE(46fcH,0300H); (* set user mode *)
X CODE(42a7H,3f3cH,20H,4e41H,42b9H,0H,420H,2079H,0H,4H,4ed0H);
X END;
X IF Hotreturn=NorMouse THEN
X gkey;
X BConOut(KDB,CHAR(08H)); (* send relative mouse *)
X END;
X IF Hotreturn=CurMouse THEN
X gkey;
X BConOut(KDB,CHAR(0aH)); (* send cursor mouse *)
X END;
X IF Hotreturn=HotKey THEN
X gkey;
X swapcli:=TRUE;
X END;
X
X CODE(23dfH,0,4a2H); (* restore BIOS pointers *)
X
X SETREG(8,ADDRESS(kpc));
X CODE(2f48H,62); (* move new pc to stack *)
X SETREG(8,ADDRESS(ksr));
X CODE(3f48H,60); (* move new sr to stack *)
X CODE(4cdfH,7fffH); (* restore regs movem *)
X CODE(4e73H); (* rte *)
XEND keytrapend;
X(*$P- *)
X
X(*$P- *)
XPROCEDURE gkey;
XBEGIN
X IF BConStat(CON) THEN
X kjunk:=BConIn(CON);
X ibuf^[kbdiorec^.ibuftl DIV 4]:=0;
X END;
X CODE(4e75H); (* rts *)
XEND gkey;
X(*$P+ *)
X
XPROCEDURE SetDrvPath(drive: CARDINAL; VAR path: ARRAY OF CHAR);
XBEGIN
X SetDrv(drive,drivemap);
X IF path[0]=0c THEN
X path[0]:='\';
X path[1]:=0c;
X path[2]:=0c;
X END;
X done:=SetPath(path);
XEND SetDrvPath;
X
X(* this is for the BIOS devices *)
X(*$P-,$S- *)
XPROCEDURE changedevbios;
XBEGIN
X CODE(48e7H,07ffeH); (* save regs *)
X CODE(306fH,56); (* move.w 56(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) THEN (* check INPUT *)
X IF dev=2 THEN
X IF currentprocess^.Iport=null THEN
X SETREG(8,a7);
X CODE(2e48H); (* move.l a0,a7 *)
X CODE(4cdfH,7ffeH); (* restore regs movem *)
X CODE(203CH,0FFFFH,0FFFFH); (* move.l -1,d0 *)
X CODE(4E73H); (* RTE return -1 on all calls *)
X END;
X IF ORD(currentprocess^.Iport)>ORD(null) THEN (* user *)
X IF cmd=2 THEN
X cin:=DeviceTable[ORD(currentprocess^.Oport)].bconin();
X SETREG(8,a7);
X CODE(2e48H); (* move.l a0,a7 *)
X SETREG(0,ADDRESS(cin));
X CODE(4cdfH,7ffeH); (* restore regs movem *)
X CODE(4E73H); (* RTE return -1 on all calls *)
X ELSE
X inok:=DeviceTable[ORD(currentprocess^.Oport)].bconstat();
X IF inok THEN
X SETREG(8,a7);
X CODE(2e48H); (* move.l a0,a7 *)
X CODE(4cdfH,7ffeH); (* restore regs movem *)
X CODE(203CH,0FFFFH,0FFFFH); (* move.l -1,d0 *)
X CODE(4E73H); (* RTE return -1 *)
X ELSE
X SETREG(8,a7);
X CODE(2e48H); (* move.l a0,a7 *)
X CODE(4cdfH,7ffeH); (* restore regs movem *)
X CODE(203CH,0H,0H); (* move.l 0,d0 *)
X CODE(4E73H); (* RTE return 0 *)
X END;
X END;
X END;
X dev:=ADDRESS(currentprocess^.Iport); (* 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 IF (cmd=3) OR (cmd=8) THEN (* check OUTPUT *)
X IF dev=2 THEN
X IF currentprocess^.Oport=null THEN
X SETREG(8,a7);
X CODE(2e48H); (* move.l a0,a7 *)
X CODE(4cdfH,7ffeH); (* restore regs movem *)
X CODE(203CH,0FFFFH,0FFFFH); (* move.l -1,d0 *)
X CODE(4E73H); (* RTE return -1 on all calls *)
X END;
X IF ORD(currentprocess^.Oport)>ORD(null) THEN
X IF cmd=3 THEN
X CODE(306fH,4); (* move.w 4(a7),a0 *)
X c:=REGISTER(8);
X DeviceTable[ORD(currentprocess^.Oport)].bconout(CHAR(c));
X SETREG(8,a7);
X CODE(2e48H); (* move.l a0,a7 *)
X CODE(4cdfH,7ffeH); (* restore regs movem *)
X CODE(203CH,0FFFFH,0FFFFH); (* move.l -1,d0 *)
X CODE(4E73H); (* RTE return -1 on all calls *)
X ELSE
X outok:=DeviceTable[ORD(currentprocess^.Oport)].bcostat();
X IF outok THEN
X SETREG(8,a7);
X CODE(2e48H); (* move.l a0,a7 *)
X CODE(4cdfH,7ffeH); (* restore regs movem *)
X CODE(203CH,0FFFFH,0FFFFH); (* move.l -1,d0 *)
X CODE(4E73H); (* RTE return -1 *)
X ELSE
X SETREG(8,a7);
X CODE(2e48H); (* move.l a0,a7 *)
X CODE(4cdfH,7ffeH); (* restore regs movem *)
X CODE(203CH,0H,0H); (* move.l 0,d0 *)
X CODE(4E73H); (* RTE return 0 *)
X END;
X END;
X END;
X dev:=ADDRESS(currentprocess^.Oport); (* 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,64); (* move.w 64(a7),a0 *)
X dev:=REGISTER(8);
X CODE(306fH,62); (* move.w 62(a7),a0 *)
X cmd:=REGISTER(8);
X IF (cmd=1) OR (cmd=2) THEN (* check INPUT *)
X IF dev=2 THEN
X IF currentprocess^.Iport=null THEN
X CODE(4cdfH,7ffeH); (* restore regs movem *)
X CODE(203CH,0FFFFH,0FFFFH); (* move.l -1,d0 *)
X CODE(4E73H); (* RTE return -1 on all calls *)
X END;
X IF ORD(currentprocess^.Iport)>ORD(null) THEN
X IF cmd=2 THEN
X cin:=DeviceTable[ORD(currentprocess^.Oport)].bconin();
X SETREG(0,ADDRESS(cin));
X CODE(4cdfH,7ffeH); (* restore regs movem *)
X CODE(4E73H); (* RTE return cin *)
X ELSE
X inok:=DeviceTable[ORD(currentprocess^.Oport)].bconstat();
X IF inok THEN
X CODE(4cdfH,7ffeH); (* restore regs movem *)
X CODE(203CH,0FFFFH,0FFFFH); (* move.l -1,d0 *)
X CODE(4E73H); (* RTE return -1 *)
X ELSE
X CODE(4cdfH,7ffeH); (* restore regs movem *)
X CODE(203CH,0H,0H); (* move.l 0,d0 *)
X CODE(4E73H); (* RTE return 0 *)
X END;
X END;
X END;
X dev:=ADDRESS(currentprocess^.Iport); (* change to port *)
X SETREG(8,dev);
X CODE(3f48H,64); (* move.w a0,64(a7) set value in stack *)
X END;
X END;
X IF (cmd=3) OR (cmd=8) THEN (* check OUTPUT *)
X IF dev=2 THEN
X IF currentprocess^.Oport=null THEN
X CODE(4cdfH,7ffeH); (* restore regs movem *)
X CODE(203CH,0FFFFH,0FFFFH); (* move.l -1,d0 *)
X CODE(4E73H); (* RTE return -1 on all calls *)
X END;
X IF ORD(currentprocess^.Oport)>ORD(null) THEN
X IF cmd=3 THEN
X CODE(306fH,66); (* move.w 66(a7),a0 *)
X c:=REGISTER(8);
X DeviceTable[ORD(currentprocess^.Oport)].bconout(CHAR(c));
X CODE(4cdfH,7ffeH); (* restore regs movem *)
X CODE(203CH,0FFFFH,0FFFFH); (* move.l -1,d0 *)
X CODE(4E73H); (* RTE return -1 on all calls *)
X ELSE
X outok:=DeviceTable[ORD(currentprocess^.Oport)].bcostat();
X IF outok THEN
X CODE(4cdfH,7ffeH); (* restore regs movem *)
X CODE(203CH,0FFFFH,0FFFFH); (* move.l -1,d0 *)
X CODE(4E73H); (* RTE return -1 *)
X ELSE
X CODE(4cdfH,7ffeH); (* restore regs movem *)
X CODE(203CH,0H,0H); (* move.l 0,d0 *)
X CODE(4E73H); (* RTE return 0 *)
X END;
X END;
X END;
X dev:=ADDRESS(currentprocess^.Oport); (* change to port *)
X SETREG(8,dev);
X CODE(3f48H,64); (* move.w a0,64(a7) set value in stack *)
X END;
X END;
X END;
X SETREG(8,tbiosSave); (* move trap adr *)
X CODE(43faH,10); (* lea 12(pc),a1 *)
X CODE(2288H); (* move.l a0,(a1) *)
X CODE(4cdfH,7ffeH); (* restore regs movem *)
X CODE(4ef9H,0,0) (* jmp back to routine *)
XEND changedevbios;
X(*$P+,$S+ *)
X
X(*$P-,$S- *)
XPROCEDURE setup;
XBEGIN
X tbios:=ADDRESS(changedevbios);
X CODE(4e75H); (* RTS *)
XEND setup;
X(*$P+,$S+ *)
X
X(*$P-,$S- *)
XPROCEDURE tbiossetup;
XBEGIN
X tbiosSave:=tbios;
X CODE(4e75H); (* RTS *)
XEND tbiossetup;
X(*$P+,$S+ *)
X(* end device routines *)
X
XPROCEDURE SelectPort;
XBEGIN
X currentprocess^.Oport:=Oportdevice;
X currentprocess^.Iport:=Iportdevice;
X IF OpenCLI>0 THEN SuperExec(setup) END;
XEND SelectPort;
X
XPROCEDURE RunProgram;
XVAR temp : String;
X p : CARDINAL;
XBEGIN
X IF (bprunning>1) THEN
X gemsaveGvec^:=ADR(currentprocess^.bpsave);
X currentprocess^.bpsave:=bpsave;
X currentprocess^.bpsave[0]:=ADR(currentprocess^.bpsave);
X END;
X SetDrvPath(requestdrv,requestpath);
X IF Pos(currentprocess^.ipname,".",0,p) THEN
X ExecProgram;
X ELSE
X temp:=currentprocess^.ipname;
X Concat(currentprocess^.ipname,".prg",
X currentprocess^.ipname);
X ExecProgram;
X IF currentprocess^.return=(-33) THEN
X currentprocess^.ipname:=temp;
X Concat(currentprocess^.ipname,".tos",
X currentprocess^.ipname);
X ExecProgram;
X END;
X IF currentprocess^.return=(-33) THEN
X currentprocess^.ipname:=temp;
X Concat(currentprocess^.ipname,".ttp",
X currentprocess^.ipname);
X ExecProgram;
X END;
X END;
XEND RunProgram;
X
X(*$P- *)
XPROCEDURE ExecProgram;
XBEGIN
X CODE(48e7H,0fffeH); (* save regs *)
X currentprocess^.tmpcor:=PROCESS(REGISTER(15));
X SETREG(8,ADR(currentprocess^.ipenvstr));
X CODE(2f08H); (* move.l a0,-(sp) *)
X SETREG(8,ADR(currentprocess^.iptail));
X CODE(2f08H); (* move.l a0,-(sp) *)
X SETREG(8,ADR(currentprocess^.ipname));
X CODE(2f08H); (* move.l a0,-(sp) *)
X CODE(3f3cH,0); (* move.w #0,-(sp) LOADEXECUTE *)
X CODE(3f3cH,4bH); (* move.w #4b,-(sp) gemdos EXEC *)
X CODE(4e41H); (* trap #1 *)
X SETREG(8,currentprocess^.tmpcor);
X CODE(2e48H); (* move.l a0,a7 *)
X CODE(4cdfH,7fffH); (* restore regs *)
X currentprocess^.return:=INTEGER(REGISTER(0));
X CODE(4e75H); (* rts *)
XEND ExecProgram;
X(*$P+ *)
X
XPROCEDURE IP;
XBEGIN
X currentprocess^.ipname:=name;
X currentprocess^.iptail:=tail;
X currentprocess^.ipenvstr:=envstr;
X SelectPort;
X INC(OpenCLI);
X INC(bprunning);
X LOOP
X MultiBegin;
X RunProgram;
X END;
XEND IP;
X
XPROCEDURE BP;
XBEGIN
X currentprocess^.ipname:=name;
X currentprocess^.iptail:=tail;
X currentprocess^.ipenvstr:=envstr;
X INC(bprunning);
X SelectPort;
X MultiBegin;
X
X RunProgram;
X MultiEnd;
X DEC(bprunning);
X IF currentprocess^.return#0 THEN
X currentprocess^.errno:=2;
X ELSE
X currentprocess^.errno:=0;
X END;
X TermProcess(currentprocess^.pid);
XEND BP;
X
XPROCEDURE Use;
XVAR i : CARDINAL;
X pid : INTEGER;
X s0 : SIGNAL;
X
XPROCEDURE CheckPort(VAR portdevice: devicetype);
XBEGIN
X nxparm;
X ltext(ADR(temp),SIZE(temp));
X IF temp[0]='-' THEN
X portdevice:=con;
X IF temp[1]='n' THEN
X portdevice:=null;
X END;
X IF temp[1]='a' THEN
X portdevice:=aux;
X END;
X IF temp[1]='m' THEN
X portdevice:=midi;
X END;
X IF temp[1]='p' THEN
X portdevice:=printer;
X END;
X IF temp[1]='0' THEN
X portdevice:=dev0;
X END;
X IF temp[1]='1' THEN
X portdevice:=dev1;
X END;
X IF temp[1]='2' THEN
X portdevice:=dev2;
X END;
X IF temp[1]='3' THEN
X portdevice:=dev3;
X END;
X ELSE
X portdevice:=con;
X bkparm;
X END;
XEND CheckPort;
X
XPROCEDURE Reset;
XBEGIN
X request.req:=FALSE;
X inuse:=FALSE;
XEND Reset;
X
XPROCEDURE gettail;
XBEGIN
X nxparm;
X etext(ADR(tail[1]),SIZE(tail));
X bkparm;
X etext(ADR(envstr),SIZE(envstr));
X tail[0]:=CHAR(Length(envstr));
X envstr:='';
XEND gettail;
X
XPROCEDURE Caps(VAR str: String); (* convert str to CAPS *)
XVAR i : INTEGER;
XBEGIN
X i:=0;
X WHILE ORD(str[i])#0 DO
X str[i]:=CAP(str[i]);
X INC(i);
X END;
XEND Caps;
X
XBEGIN
X IF request.magic#MAGIC THEN
X request.magic:=0;
X currentprocess^.errno:=54;
X Reset;
X RETURN;
X END;
X request.magic:=0;
X cmdstring:=command;
X inuse:=TRUE;
X scinit(ADR(cmdstring),SIZE(cmdstring));
X nxparm;
X ltext(ADR(name),SIZE(name));
X Caps(name);
X IF Compare("IP",name)=Equal THEN
X nxparm;
X ltext(ADR(name),SIZE(name));
X
X gettail;
X
X pri:=5;
X FOR i:=0 TO 79 DO
X pname[i]:=name[i];
X END;
X Reset;
X Oportdevice:=con;
X Iportdevice:=con;
X proc:=IP;
X sizewsp:=1000;
X SuperExec(getvector);
X StartProcess(proc,sizewsp,pri,pname,par);
X RETURN;
X END;
X IF Compare("BP",name)=Equal THEN
X CheckPort(Iportdevice);
X CheckPort(Oportdevice);
X nxparm;
X ltext(ADR(temp),SIZE(temp));
X ConvertToInteger(temp,done,pri);
X IF NOT done THEN
X pri:=4;
X bkparm;
X END;
X nxparm;
X ltext(ADR(name),SIZE(name));
X
X gettail;
X
X FOR i:=0 TO 79 DO
X pname[i]:=name[i];
X END;
X Reset;
X proc:=BP;
X sizewsp:=2000;
X SuperExec(getbiosvector);
X StartProcess(proc,sizewsp,pri,pname,par);
X RETURN;
X END;
X IF Compare("FP",name)=Equal THEN
X CheckPort(Iportdevice);
X CheckPort(Oportdevice);
X nxparm;
X ltext(ADR(temp),SIZE(temp));
X ConvertToInteger(temp,done,pri);
X IF NOT done THEN
X pri:=5;
X bkparm;
X END;
X nxparm;
X ltext(ADR(name),SIZE(name));
X
X gettail;
X
X FOR i:=0 TO 79 DO
X pname[i]:=name[i];
X END;
X Reset;
X proc:=BP;
X sizewsp:=2000;
X SuperExec(getvector);
X StartProcess(proc,sizewsp,pri,pname,par);
X RETURN;
X END;
X IF Compare("PORT",name)=Equal THEN
X nxparm;
X ltext(ADR(name),SIZE(name));
X ConvertToInteger(name,done,pid);
X IF (NOT done) OR (NOT (pid > clipid)) THEN
X Reset;
X RETURN;
X END;
X s0:=currentprocess;
X LOOP
X s0:=s0^.next;
X IF s0^.pid=1 THEN Reset; RETURN; END;
X IF s0^.pid=pid THEN EXIT END;
X END;
X CheckPort(s0^.Iport);
X CheckPort(s0^.Oport);
X Reset;
X RETURN;
X END;
X IF Compare("CRON",name)=Equal THEN
X nxparm;
X ltext(ADR(name),SIZE(name));
X Caps(name);
X IF Compare("ON",name)=Equal THEN
X CronActive:=TRUE;
X LoadCRON;
X END;
X IF Compare("OFF",name)=Equal THEN
X CronActive:=FALSE;
X END;
X Reset;
X RETURN;
X END;
X IF Compare("NICE",name)=Equal THEN
X nxparm;
X ltext(ADR(name),SIZE(name));
X ConvertToInteger(name,done,pri);
X IF NOT done THEN
X Reset;
X RETURN;
X END;
X nxparm;
X ltext(ADR(name),SIZE(name));
X IF state.return=0 THEN
X ConvertToInteger(name,done,pid);
X IF NOT done THEN
X pid:=request.pid;
X END;
X ELSE
X pid:=request.pid;
X END;
X ChangeProcessPriority(pid,pri);
X Reset;
X RETURN;
X END;
X IF Compare("HP",name)=Equal THEN
X nxparm;
X ltext(ADR(name),SIZE(name));
X ConvertToInteger(name,done,pid);
X IF done THEN
X SleepProcess(pid);
X ELSE
X currentprocess^.errno:=3;
X END;
X Reset;
X RETURN;
X END;
X IF Compare("WP",name)=Equal THEN
X nxparm;
X ltext(ADR(name),SIZE(name));
X ConvertToInteger(name,done,pid);
X IF done THEN
X WakeupProcess(pid);
X ELSE
X currentprocess^.errno:=3;
X END;
X Reset;
X RETURN;
X END;
X IF Compare("KILL",name)=Equal THEN
X nxparm;
X ltext(ADR(name),SIZE(name));
X ConvertToInteger(name,done,pid);
X IF done AND (pid>clipid) THEN
X TermProcess(pid);
X ELSE
X currentprocess^.errno:=3;
X END;
X Reset;
X RETURN;
X END;
X Reset;
XEND Use;
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 *)
SHAR_EOF
echo "End of part 3, continue with part 4"
echo "4" > s2_seq_.tmp
exit 0