koreth@ssyx.ucsc.edu.ucsc.edu (Steven Grimm) (12/28/88)
Submitted-by: madsen@sask.usask.ca (Jorgen Madsen)
Posting-number: Volume 1, Issue 87
Archive-name: mx2v230/part07
#!/bin/sh
# this is part 7 of a multipart archive
# do not concatenate these parts, unpack them in order with /bin/sh
# file SCANNER.MOD continued
#
CurArch=7
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' >> SCANNER.MOD
X state.return:=(-2);
X EXIT;
X END;
X state.disp:=i;
X state.return:=0;
X EXIT;
X END;
X INC(i);
X INC(j);
X INC(chrptr);
X INC(textbuf);
X END;
XEND ltext;
X
XPROCEDURE etext(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 chrptr^# 0C 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 *)
X state.return:=(-2);
X EXIT;
X END;
X state.disp:=i;
X state.return:=0;
X EXIT;
X END;
X INC(i);
X INC(j);
X INC(chrptr);
X INC(textbuf);
X END;
XEND etext;
X
XBEGIN
XEND SCANNER.
SHAR_EOF
chmod 0600 SCANNER.MOD || echo "restore of SCANNER.MOD fails"
sed 's/^X//' << 'SHAR_EOF' > SPAWN.MOD &&
X
X(* Copyright 1987 fred brooks LogicTek *)
X(* *)
X(* *)
X(* First Release 12/8/87-FGB *)
X(* *)
X
X(*$A+,$S-,$T- *)
XMODULE spawn;
XFROM ATOMIC IMPORT MultiBegin,sysvariable,GEMTYPE,ROMDATE,
X OTOS,MTOS,OLDDATE,NEWDATE;
XFROM SYSCALL IMPORT SysVar,Sleep;
XFROM SYSTEM IMPORT ADDRESS;
XFROM GEMDOS IMPORT OldTerm;
XVAR sv : sysvariable;
X gem1 [OTOS] : POINTER TO GEMTYPE;
X gem2 [MTOS] : POINTER TO GEMTYPE;
X
XBEGIN
X SysVar(sv);
X IF ROMDATE=OLDDATE THEN
X sv.bpsave^:=gem1^;
X sv.bpsave^[0]:=ADDRESS(gem1);
X END;
X IF ROMDATE=NEWDATE THEN
X sv.bpsave^:=gem2^;
X sv.bpsave^[0]:=ADDRESS(gem2);
X END;
X MultiBegin;
X Sleep;
X OldTerm;
XEND spawn.
SHAR_EOF
chmod 0600 SPAWN.MOD || echo "restore of SPAWN.MOD fails"
sed 's/^X//' << 'SHAR_EOF' > SPOOLER.MOD &&
X(* this module uses spint 0 to communicate with a controller program
X Commands are sent via the spintinfo call. and pass values thru
X the spintcmd variable. Please look at lp.mod for an example.
X current commands are:
X 1 examine spool directory. print any files that exist then delete.
X 2 spool queue.
X 99 terminate spooler.prg.
X*)
X
XMODULE spooler;
XFROM XBIOS IMPORT SuperExec;
XFROM SYSTEM IMPORT BYTE,ADR,CODE,ADDRESS;
XFROM GEMDOS IMPORT DirCreate,Open,Close,SetDTA,Delete,SFirst,SNext,
X SetPath,Alloc,Free,Read,GetPath,OldTerm;
XFROM TextIO IMPORT WriteString,WriteLn,WriteAdr;
XFROM BIOS IMPORT Device,BCosStat,BConOut;
XFROM Streams IMPORT OpenStream,CloseStream,StreamKinds,Stream;
XFROM SYSCALL IMPORT EnableSpint,SwapProcess,SleepProcess,
X WakeupProcess,ProcessPid,DisableSpint;
XTYPE dtatype = RECORD
X res : ARRAY [0..20] OF BYTE;
X attr : BYTE;
X time : CARDINAL;
X date : CARDINAL;
X size : LONGCARD;
X name : ARRAY [0..13] OF CHAR;
X END;
XVAR result,i,return,d,pid : INTEGER;
X DTA : dtatype;
X ok : BOOLEAN;
X count : INTEGER;
X ch : BYTE;
X S : Stream;
X endpos,currentpos,delay : LONGCARD;
X C,char : POINTER TO CHAR;
X spintcmd : ARRAY [0..1] OF
X LONGCARD;
XPROCEDURE sq;
XBEGIN
X WriteLn;
X IF currentpos#endpos THEN
X WriteString("Printing ");
X WriteString(DTA.name);
X WriteAdr(ADDRESS(endpos),7);
X WriteString(" total characters");
X WriteAdr(ADDRESS(endpos-currentpos),7);
X WriteString(" characters left to print.");
X ELSE
X WriteString("Nothing.");
X END;
X WriteLn;
XEND sq;
X
XPROCEDURE run;
XBEGIN
X IF (spintcmd[0]=1) OR (spintcmd[0]=99) THEN
X WakeupProcess(pid);
X END;
X IF spintcmd[0]=2 THEN
X sq;
X END;
XEND run;
X
XBEGIN
X spintcmd[1]:=LONGCARD(sq);
X pid:=ProcessPid();
X ok:=SetPath("\");
X ok:=DirCreate("mx2spool");
X IF ok THEN
X WriteString("Creating spool directory -> \MX2SPOOL");
X WriteLn;
X END;
X ok:=SetPath("\mx2spool");
X IF NOT ok THEN
X DisableSpint(0);
X WriteString("Unable to create or use MX2SPOOL directory");
X WriteLn;
X OldTerm;
X END;
X ok:=EnableSpint(0,run,ADR(spintcmd)); (* spint to start spooler *)
X SetDTA(ADR(DTA));
X LOOP
X SFirst("*.*",0,result);
X WHILE result=0 DO
X
X count:=0;
X OpenStream(S,DTA.name,READ,return);
X IF return<0 THEN
X ELSE
X currentpos:=0;
X endpos:=S.endPos;
X Alloc(endpos,C);
X char:=C;
X IF char#NIL THEN
X Read(S.handle,endpos,char);
X CloseStream(S,return);
X WHILE (currentpos#endpos) DO
X WHILE NOT BCosStat(PRT) DO
X INC(delay);
X IF delay>1000 THEN
X delay:=0;
X SwapProcess;
X END;
X END;
X BConOut(PRT,char^);
X INC(currentpos);
X INC(char);
X INC(count);
X IF count>32 THEN
X count:=0;
X SwapProcess;
X IF spintcmd[0]=99 THEN
X DisableSpint(0);
X OldTerm;
X END;
X END;
X END;
X IF Free(C) THEN END;
X BConOut(PRT,CHAR(0cH)); (* send formfeed *)
X ELSE
X CloseStream(S,return);
X WriteString(DTA.name);
X WriteString(" * SPOOLER OUT OF MEMORY *");
X WriteLn;
X END;
X END;
X ok:=Delete(DTA.name);
X SNext(result);
X END;
X SleepProcess(pid);
X IF spintcmd[0]=99 THEN
X DisableSpint(0);
X OldTerm;
X END;
X END;
XEND spooler.
SHAR_EOF
chmod 0600 SPOOLER.MOD || echo "restore of SPOOLER.MOD fails"
sed 's/^X//' << 'SHAR_EOF' > SQ.MOD &&
XMODULE sq;
XFROM SYSCALL IMPORT SpintInfo;
XFROM GEMDOS IMPORT Term;
XFROM Terminal IMPORT WriteString,WriteLn;
XVAR spintcmd : POINTER TO ARRAY [0..1] OF LONGCARD;
X SQ : PROC;
X ok : BOOLEAN;
XBEGIN
X IF SpintInfo(0,spintcmd) THEN
X SQ:=PROC(spintcmd^[1]);
X SQ();
X ELSE
X WriteLn;
X WriteString("Background spooler not running");
X WriteLn;
X ok:=Term(-1);
X END;
X ok:=Term(0);
XEND sq.
SHAR_EOF
chmod 0600 SQ.MOD || echo "restore of SQ.MOD fails"
sed 's/^X//' << 'SHAR_EOF' > SUBMIT.MOD &&
X
X(* Copyright 1987 fred brooks LogicTek *)
X(* *)
X(* *)
X(* First Release 12/8/87-FGB *)
X(* *)
X
XMODULE submit;
X
XFROM SYSTEM IMPORT ADDRESS;
XFROM GEMX IMPORT BasePageAddress ;
XFROM XBIOS IMPORT IOREC,IORECPTR,SerialDevice,IORec;
XFROM GEMDOS IMPORT OldTerm;
XVAR char : CHAR;
X i : CARDINAL;
X kbdiorec : IORECPTR;
X ibuf : POINTER TO ARRAY [0..63] OF
X LONGCARD;
X
XBEGIN;
X kbdiorec:=IORec(Keyboard);
X ibuf:=kbdiorec^.ibuf;
X char:=BasePageAddress^.CmdLine[1];
X FOR i:=1 TO ORD(BasePageAddress^.CmdLine[0])+1 DO
X ibuf^[i]:=LONGCARD(BasePageAddress^.CmdLine[i]);
X END;
X ibuf^[ORD(BasePageAddress^.CmdLine[0])+1]:=LONGCARD(0dH);
X kbdiorec^.ibufhd:=0;
X kbdiorec^.ibuftl:=(ORD(BasePageAddress^.CmdLine[0])+1)*4;
X OldTerm;
XEND submit.
SHAR_EOF
chmod 0600 SUBMIT.MOD || echo "restore of SUBMIT.MOD fails"
sed 's/^X//' << 'SHAR_EOF' > SUBMITA.MOD &&
X
X(* Copyright 1987 fred brooks LogicTek *)
X(* *)
X(* *)
X(* First Release 12/8/87-FGB *)
X(* *)
X
X(*$A+ *)
XMODULE submita;
XFROM SYSTEM IMPORT ADDRESS;
XFROM GEMX IMPORT BasePageAddress ;
XFROM XBIOS IMPORT IOREC,IORec,IORECPTR,SerialDevice;
XFROM GEMDOS IMPORT OldTerm;
XVAR char : CHAR;
X i,count : CARDINAL;
X kbdiorec : IORECPTR;
X ibuf : POINTER TO ARRAY [0..255] OF
X CHAR;
X
XBEGIN;
X kbdiorec:=IORec(RS232);
X ibuf:=kbdiorec^.ibuf;
X char:=BasePageAddress^.CmdLine[1];
X count:=ORD(BasePageAddress^.CmdLine[0])+1;
X IF count>78 THEN count:=78 END;
X FOR i:=1 TO count DO
X ibuf^[i]:=CHAR(BasePageAddress^.CmdLine[i]);
X END;
X ibuf^[count]:=CHAR(0dH);
X kbdiorec^.ibufhd:=0;
X kbdiorec^.ibuftl:=count;
X OldTerm;
XEND submita.
SHAR_EOF
chmod 0600 SUBMITA.MOD || echo "restore of SUBMITA.MOD fails"
sed 's/^X//' << 'SHAR_EOF' > SUBMITM.MOD &&
X
X(* Copyright 1987 fred brooks LogicTek *)
X(* *)
X(* *)
X(* First Release 12/8/87-FGB *)
X(* *)
X
X(*$A+ *)
XMODULE submita;
XFROM SYSTEM IMPORT ADDRESS;
XFROM GEMX IMPORT BasePageAddress ;
XFROM XBIOS IMPORT IOREC,IORec,IORECPTR,SerialDevice;
XFROM GEMDOS IMPORT OldTerm;
XVAR char : CHAR;
X i,count : CARDINAL;
X kbdiorec : IORECPTR;
X ibuf : POINTER TO ARRAY [0..127] OF
X CHAR;
X
XBEGIN;
X kbdiorec:=IORec(MIDI);
X ibuf:=kbdiorec^.ibuf;
X char:=BasePageAddress^.CmdLine[1];
X count:=ORD(BasePageAddress^.CmdLine[0])+1;
X IF count>78 THEN count:=78 END;
X FOR i:=2 TO count DO
X ibuf^[i]:=CHAR(BasePageAddress^.CmdLine[i-1]);
X END;
X ibuf^[count+1]:=CHAR(0dH);
X kbdiorec^.ibufhd:=0;
X kbdiorec^.ibuftl:=count+1;
X OldTerm;
XEND submita.
SHAR_EOF
chmod 0600 SUBMITM.MOD || echo "restore of SUBMITM.MOD fails"
sed 's/^X//' << 'SHAR_EOF' > SYS.MOD &&
X
X(* Copyright 1987 fred brooks LogicTek *)
X(* *)
X(* *)
X(* First Release 12/8/87-FGB *)
X(* *)
X
X(*$S-,$T- *)
XMODULE SYS;
XFROM SYSCALL IMPORT SysCmd;
XFROM GEMDOS IMPORT OldTerm;
XBEGIN
X SysCmd; (* submit to kernal *)
X OldTerm;
XEND SYS.
SHAR_EOF
chmod 0600 SYS.MOD || echo "restore of SYS.MOD fails"
sed 's/^X//' << 'SHAR_EOF' > SYSCALL.DEF &&
X
X(* Copyright 1987 fred brooks LogicTek *)
X(* *)
X(* *)
X(* First Release 12/8/87-FGB *)
X(* Add ProcessPid to return PID of calling process *)
X(* 12/12/87-FGB *)
X(* Added variable parm to StartProcess to pass info to process *)
X(* in currentprocess.gemsave[15] 1/1/88-FGB *)
X(* *)
X
XDEFINITION MODULE SYSCALL;
X
XFROM ATOMIC IMPORT SIGNAL,sysvariable;
XFROM SYSTEM IMPORT ADDRESS;
XFROM Strings IMPORT String;
X
XCONST (* SYSTEM ERRORS *)
X
X ENOERR = 0; (* no error *)
X ENOENT = 2; (* no file or directory *)
X ENORCH = 3; (* no such process *)
X ENOMEM = 12; (* out of memory *)
X EBADRQC = 54; (* bad request *)
X
X(* Read the program command line and pass it to kernel to execute *)
XPROCEDURE SysCmd;
X
X(* Pass command line to kernal to execute *)
XPROCEDURE SysReq(VAR command: ARRAY OF CHAR);
X
X(* Get the processdescriptor for the currentprocess *)
XPROCEDURE SysDes(VAR currentprocess : SIGNAL);
X
X(* Get the systemvariables ,These are copies of the variables *)
XPROCEDURE SysVar(VAR sysvar : sysvariable);
X
X(* Return PID of calling process *)
XPROCEDURE ProcessPid(): INTEGER;
X
X(* Put procedure to sleep *)
XPROCEDURE Sleep;
X
X(* check to see if special interrupt has happened , execute if triggered *)
XPROCEDURE CheckSpint;
X
X(* Setup spint linkage to spintid *)
XPROCEDURE EnableSpint(spintid: CARDINAL; routine: PROC; data: ADDRESS): BOOLEAN;
X
X(* request spint data and active info return TRUE if active bit set *)
X(* data will be set to NIL if the spint is disabled *)
XPROCEDURE SpintInfo(spintid: CARDINAL; VAR data: ADDRESS): BOOLEAN;
X
X(* remove spint linkage to spintid *)
XPROCEDURE DisableSpint(spintid: CARDINAL);
X
X(* send spint to routine *)
XPROCEDURE Trigger(spintid: CARDINAL): BOOLEAN;
X
X(* Hold program interrupts *)
XPROCEDURE HoldSpint(spintid: CARDINAL);
X
X(* Release program interrupts *)
XPROCEDURE ReleaseSpint(spintid: CARDINAL);
X
X(* Wait a specified period of time for a program interrupt ticks are
X in 200 hz clocks. If tick is -1 then wait forever for interrupt *)
XPROCEDURE IntDelay(tick: LONGINT): INTEGER;
X
X(* create a process for the MX2 system, place in the scheduler ready
X list, start new process *)
XPROCEDURE StartProcess(VAR P: PROC;
X VAR n: LONGCARD;
X VAR priority: INTEGER;
X VAR pn: String;
X VAR parm: ADDRESS);
X
X(* store the currentprocess and switch to next process in ready list *)
XPROCEDURE SwapProcess;
X
X(* end process and remove it from the ready list, free memory used by
X process *)
XPROCEDURE TermProcess(VAR id: INTEGER);
X
X(* return the next pid the system will use for a new process *)
XPROCEDURE NextPid(): INTEGER;
X
X(* tell scheduler not to run this process but keep in memory *)
XPROCEDURE SleepProcess(VAR id: INTEGER);
X
X(* tell scheduler tp sleep for msec 1000th of a second *)
XPROCEDURE DozeProcess(VAR id: INTEGER; VAR msec: LONGCARD);
X
X(* Sleep process until the contents of 'loc' equals 'value AND mask'.
Xmsec is the timeout value in milliseconds if set the 0 it waits forever *)
XPROCEDURE WaitProcess(VAR id: INTEGER; VAR loc: ADDRESS;
X VAR value,mask,msec: LONGCARD);
X
X(* tell scheduler to start running this process again if it was sleeping
X before *)
XPROCEDURE WakeupProcess(VAR id: INTEGER);
X
X(* change process priority *)
XPROCEDURE ChangeProcessPriority(VAR id: INTEGER; VAR pri: INTEGER);
X
X(* turn on the scheduler interrupt, and start normal process switching *)
XPROCEDURE MultiBegin;
X
X(* turn off the scheduler interrupt, used to stop process switching in
X section of code that should not be swapped out *)
XPROCEDURE MultiEnd;
X
XEND SYSCALL.
SHAR_EOF
chmod 0600 SYSCALL.DEF || echo "restore of SYSCALL.DEF fails"
sed 's/^X//' << 'SHAR_EOF' > SYSCALL.MOD &&
X
X(* Copyright 1987 fred brooks LogicTek *)
X(* *)
X(* *)
X(* First Release 12/8/87-FGB *)
X(* Added variable parm to StartProcess to pass info to process *)
X(* in currentprocess.gemsave[15] 1/1/88-FGB *)
X(* Fixed SpintInfo to give info anytime. It was giving info *)
X(* only after a spint was enabled before it was executed. *)
X(* 5/21/88-FGB *)
X(* *)
X
X(*$S-,$T- *)
XIMPLEMENTATION MODULE SYSCALL;
XFROM ATOMIC IMPORT sysvariable,CheckFlag,SetFlag,MAGIC,SIGNAL,
X spinttype;
XFROM XBIOS IMPORT SuperExec;
XFROM SYSTEM IMPORT CODE,ADDRESS;
XFROM GEMX IMPORT BasePageAddress;
XFROM GEMDOS IMPORT GetPath,GetDrv,Super;
XFROM Strings IMPORT String;
X
XVAR sysvar : sysvariable;
X sysvector [144H] : POINTER TO sysvariable;
X goodbye : BOOLEAN;
X i,wait,drv : CARDINAL;
X currentprocess : SIGNAL;
X ssv : ADDRESS;
X
X(*$P- *)
XPROCEDURE submit;
XBEGIN
X sysvar:=sysvector^;
X CODE(4e75H); (* rts *)
XEND submit;
X(*$P+ *)
X
XPROCEDURE SysCmd;
XBEGIN
X MultiEnd;
X SuperExec(submit);
X
X FOR i:=1 TO 79 DO
X sysvar.command^[i-1]:=BasePageAddress^.CmdLine[i];
X END;
X sysvar.command^[ORD(BasePageAddress^.CmdLine[0])]:=CHAR(0);
X
X MultiBegin;
X (* wait until no commands are being executed *)
X REPEAT
X UNTIL NOT CheckFlag(sysvar.request^.req);
X MultiEnd;
X
X (* tell SCHED that we want him to show his face *)
X sysvar.request^.magic:=MAGIC;
X currentprocess:=sysvar.currentprocess^;
X sysvar.request^.pid:=currentprocess^.pid;
X GetPath(currentprocess^.ipenvstr,0);
X GetDrv(drv);
X currentprocess^.flags[0]:=LONGCARD(drv);
X SetFlag(sysvar.request^.req);
X MultiBegin;
XEND SysCmd;
X
XPROCEDURE SysReq(VAR command: ARRAY OF CHAR);
XBEGIN
X MultiEnd;
X SuperExec(submit);
X
X FOR i:=0 TO HIGH(command)-1 DO
X sysvar.command^[i]:=command[i];
X END;
X sysvar.command^[HIGH(command)]:=0C;
X
X MultiBegin;
X (* wait until no commands are being executed *)
X REPEAT
X UNTIL NOT CheckFlag(sysvar.request^.req);
X
X (* tell SCHED that we want him to show his face *)
X sysvar.request^.magic:=MAGIC;
X currentprocess:=sysvar.currentprocess^;
X sysvar.request^.pid:=currentprocess^.pid;
X GetPath(currentprocess^.ipenvstr,0);
X GetDrv(drv);
X currentprocess^.flags[0]:=LONGCARD(drv);
X SetFlag(sysvar.request^.req);
X MultiBegin;
XEND SysReq;
X
XPROCEDURE SysDes(VAR cp: SIGNAL);
XBEGIN
X SuperExec(submit);
X cp:=sysvar.currentprocess^;
XEND SysDes;
X
XPROCEDURE SysVar(VAR sv: sysvariable);
XBEGIN
X SuperExec(submit);
X sv:=sysvar;
XEND SysVar;
X
XPROCEDURE ProcessPid(): INTEGER;
XBEGIN
X SuperExec(submit);
X SysVar(sysvar);
X currentprocess:=sysvar.currentprocess^;
X RETURN currentprocess^.pid;
XEND ProcessPid;
X
XPROCEDURE Sleep;
XVAR pid : INTEGER;
XBEGIN
X pid:=ProcessPid();
X SleepProcess(pid);
XEND Sleep;
X
XPROCEDURE FindProcess(pid: INTEGER; cp: SIGNAL): SIGNAL;
XVAR s : SIGNAL;
XBEGIN
X s:=cp;
X LOOP (* find process id *)
X s:=s^.next;
X IF s^.pid=pid THEN (* found id *)
X RETURN s;
X END;
X IF s^.pid=cp^.pid THEN (* id not found in list *)
X RETURN NIL;
X END;
X END;
XEND FindProcess;
X
XPROCEDURE CheckSpint;
XBEGIN
X SuperExec(submit);
X
X FOR i:=0 TO 15 DO (* check all spints and run if set *)
X IF (i IN sysvar.spintenable^)
X AND (i IN sysvar.spintmask^)
X AND (ADDRESS(sysvar.spint^[i].proc)#NIL) THEN
X sysvar.spint^[i].proc;
X END;
X EXCL(sysvar.spintenable^,i); (* clear flag after complete *)
X END;
XEND CheckSpint;
X
XPROCEDURE EnableSpint(spintid: CARDINAL; routine: PROC;
X data: ADDRESS): BOOLEAN;
XBEGIN
X SuperExec(submit);
X
X IF spintid>15 THEN RETURN FALSE END;
X sysvar.spint^[spintid].proc:=routine;
X sysvar.spint^[spintid].data:=data;
X INCL(sysvar.spintmask^,spintid);
X RETURN TRUE;
XEND EnableSpint;
X
XPROCEDURE SpintInfo(spintid: CARDINAL; VAR data: ADDRESS): BOOLEAN;
XBEGIN
X SuperExec(submit);
X IF spintid>15 THEN RETURN FALSE END;
X data:=sysvar.spint^[spintid].data;
X IF ADDRESS(sysvar.spint^[spintid].proc)#NIL THEN
X RETURN TRUE;
X ELSE;
X data:=NIL;
X RETURN FALSE;
X END;
XEND SpintInfo;
X
XPROCEDURE DisableSpint(spintid: CARDINAL);
XBEGIN
X SuperExec(submit);
X
X IF spintid>15 THEN RETURN END;
X sysvar.spint^[spintid].proc:=PROC(NIL);
X EXCL(sysvar.spintenable^,spintid);
X EXCL(sysvar.spintmask^,spintid);
XEND DisableSpint;
X
XPROCEDURE HoldSpint(spintid: CARDINAL);
XBEGIN
X SuperExec(submit);
X
X IF spintid>15 THEN RETURN END;
X EXCL(sysvar.spintmask^,spintid);
XEND HoldSpint;
X
XPROCEDURE ReleaseSpint(spintid: CARDINAL);
XBEGIN
X SuperExec(submit);
X
X IF spintid>15 THEN RETURN END;
X INCL(sysvar.spintmask^,spintid);
XEND ReleaseSpint;
X
XPROCEDURE IntDelay(tick: LONGINT): INTEGER;
XVAR cp : SIGNAL;
XBEGIN
X SysDes(cp);
X cp^.active:=FALSE; (* put process to sleep *)
X MultiBegin;
X REPEAT
X UNTIL cp^.active; (* wait until active *)
XEND IntDelay;
X
XPROCEDURE Trigger(spintid: CARDINAL): BOOLEAN;
XBEGIN
X SuperExec(submit);
X
X IF spintid>15 THEN RETURN FALSE END;
X INCL(sysvar.spintenable^,spintid);
X RETURN TRUE;
XEND Trigger;
X
XPROCEDURE StartProcess(VAR P: PROC;
X VAR n: LONGCARD;
X VAR priority: INTEGER;
X VAR pn: String;
X VAR parm: ADDRESS);
XBEGIN
X SuperExec(submit);
X currentprocess:=sysvar.currentprocess^;
X sysvar.request^.pid:=currentprocess^.pid;
X sysvar.StartProcess(P,n,priority,pn,parm);
XEND StartProcess;
X
XPROCEDURE SwapProcess;
XBEGIN
X SuperExec(submit);
X sysvar.SwapProcess;
XEND SwapProcess;
X
XPROCEDURE TermProcess(VAR id: INTEGER);
XBEGIN
X SuperExec(submit);
X sysvar.TermProcess(id);
XEND TermProcess;
X
XPROCEDURE NextPid(): INTEGER;
XVAR Pid : INTEGER;
XBEGIN
X SuperExec(submit);
X Pid:=sysvar.NextPid();
X RETURN Pid;
XEND NextPid;
X
XPROCEDURE SleepProcess(VAR id: INTEGER);
XBEGIN
X SuperExec(submit);
X sysvar.SleepProcess(id);
XEND SleepProcess;
X
XPROCEDURE DozeProcess(VAR id: INTEGER; VAR msec: LONGCARD);
XBEGIN
X SuperExec(submit);
X sysvar.DozeProcess(id,msec);
XEND DozeProcess;
X
XPROCEDURE WaitProcess(VAR id: INTEGER; VAR loc: ADDRESS;
X VAR value,mask,msec: LONGCARD);
XBEGIN
X SuperExec(submit);
X sysvar.WaitProcess(id,loc,value,mask,msec);
XEND WaitProcess;
X
XPROCEDURE WakeupProcess(VAR id: INTEGER);
XBEGIN
X SuperExec(submit);
X sysvar.WakeupProcess(id);
XEND WakeupProcess;
X
XPROCEDURE ChangeProcessPriority(VAR id: INTEGER; VAR pri: INTEGER);
XBEGIN
X SuperExec(submit);
X sysvar.ChangeProcessPriority(id,pri);
XEND ChangeProcessPriority;
X
XPROCEDURE MultiBegin;
XBEGIN
X SuperExec(submit);
X sysvar.MultiBegin;
XEND MultiBegin;
X
XPROCEDURE MultiEnd;
XBEGIN
X SuperExec(submit);
X sysvar.MultiEnd;
XEND MultiEnd;
X
XBEGIN
XEND SYSCALL.
X
SHAR_EOF
chmod 0600 SYSCALL.MOD || echo "restore of SYSCALL.MOD fails"
sed 's/^X//' << 'SHAR_EOF' > XA.MOD &&
XMODULE xa;
XFROM SYSCALL IMPORT SpintInfo,Trigger;
XFROM GEMDOS IMPORT Term;
XFROM Terminal IMPORT WriteString,WriteLn;
XVAR spintcmd : POINTER TO ARRAY [0..2] OF LONGCARD;
X ok : BOOLEAN;
XBEGIN
X IF SpintInfo(1,spintcmd) THEN
X spintcmd^[0]:=99;
X ok:=Trigger(1);
X ELSE
X WriteLn;
X WriteString("Background xmodem not running");
X WriteLn;
X ok:=Term(-1);
X END;
X ok:=Term(0);
XEND xa.
SHAR_EOF
chmod 0600 XA.MOD || echo "restore of XA.MOD fails"
sed 's/^X//' << 'SHAR_EOF' > XMODEM.DEF &&
X
X(* Copyright 1987 fred brooks LogicTek *)
X(* *)
X(* *)
X(* First Release 12/8/87-FGB *)
X(* *)
X
XDEFINITION MODULE XMODEM;
XFROM Strings IMPORT String;
XVAR xmodemerror : INTEGER; (* xmodem errors *)
X xmodemabort : BOOLEAN; (* timeout or abort flag *)
X crcmode : BOOLEAN; (* set crc or checksum *)
X xfrname : String;
X mdmPacketsSent : INTEGER;
X mdmPacketsReceived : INTEGER;
X mdmBadPackets : INTEGER;
X mdmNakedPackets : INTEGER;
X mdmBytesXferred : LONGCARD;
X endblk : INTEGER;
X
XPROCEDURE xmodemrec(filename: ARRAY OF CHAR): BOOLEAN;
XPROCEDURE xmodemsnd(filename: ARRAY OF CHAR): BOOLEAN;
XPROCEDURE xmodemstat;
X
XEND XMODEM.
SHAR_EOF
chmod 0600 XMODEM.DEF || echo "restore of XMODEM.DEF fails"
sed 's/^X//' << 'SHAR_EOF' > XMODEM.MOD &&
X
X(* Copyright 1987 fred brooks LogicTek *)
X(* *)
X(* *)
X(* First Release 12/8/87-FGB *)
X(* Minor fixups 3/7/88-FGB *)
X(* *)
X
X(*$T-,$S-,$A+ *)
X(* This version of xmodem has been written using UNIX and the sealink
X C programming versions as examples. Many thanks to those who have done
X this before me. Fred Brooks *)
X
XIMPLEMENTATION MODULE XMODEM;
XFROM SYSTEM IMPORT ADDRESS, CODE, REGISTER, SETREG, ADR, WORD;
XFROM GEMX IMPORT BasePageAddress, BasePageType ;
XFROM BIOS IMPORT BConStat, BCosStat, BConIn, BConOut, Device;
XFROM XBIOS IMPORT SuperExec;
XFROM GEMDOS IMPORT Create, Open, Close, Write, Read, GetDTA, SFirst;
XFROM TextIO IMPORT WriteString, WriteLn, WriteInt, WriteAdr;
XFROM BitStuff IMPORT WAnd, WEor, WShl, WShr;
XFROM Strings IMPORT String, Assign;
X
XTYPE CharPtr = POINTER TO ARRAY [0..MAX(LONGINT)] OF CHAR;
X
XCONST SECSIZ = 80H;
X BUFSIZ = 200H;
X ERRORMAX = 20;
X RETRYMAX = 20;
X SOH = 1c;
X EOT = 4c;
X ACK = 6c;
X NAK = 25c;
X C = 103c;
X RTS = 4e75H;
X BELL = 7c;
X CTRLZ = 32c;
X
XVAR result,mtimeout : INTEGER;
X filename : String;
X hz200 [04baH] : LONGCARD;
X t1,prtime : LONGCARD;
X readchar : CHAR;
X filesize : POINTER TO LONGCARD;
X snd,rec,ok : BOOLEAN;
X
X(*$P- *)
XPROCEDURE rdtime(); (* read 200hz clock *)
XBEGIN
X prtime:=hz200;
X CODE(RTS);
XEND rdtime;
X(*$P+ *)
X
XPROCEDURE GetTime(): LONGCARD;
XBEGIN
X SuperExec(rdtime);
X RETURN prtime;
XEND GetTime;
X
XPROCEDURE timerset(time: INTEGER): LONGCARD;
XBEGIN
X RETURN (LONGCARD(time)+(GetTime() DIV 20));
XEND timerset;
X
XPROCEDURE timeup(timer: LONGCARD): BOOLEAN;
XBEGIN
X IF ((GetTime() DIV 20)>timer) OR ((GetTime() DIV 20)=timer) THEN
X RETURN TRUE;
X ELSE
X RETURN FALSE;
X END;
XEND timeup;
X
XPROCEDURE errorbells;
XVAR i,delay : CARDINAL;
XBEGIN
X FOR i:=0 TO 3 DO
X FOR delay:=0 TO 10000 DO END;
X BConOut(CON,BELL);
X END;
XEND errorbells;
X
XPROCEDURE crcupdate(crcvalue: CARDINAL; data: CHAR): CARDINAL;
XCONST GEN1X5X12X16 = 1021H;
XVAR i,xin,cha : INTEGER;
X t : CARDINAL;
XBEGIN
X cha:=INTEGER(data);
X FOR i:=0 TO 7 DO
X xin:=INTEGER(WAnd(crcvalue,8000H));
X cha:=INTEGER(WShl(cha,1));
X IF INTEGER(WAnd(cha,100H))#0 THEN
X t:=crcvalue;
X crcvalue:=1+CARDINAL(WShl(t,1));
X ELSE
X t:=crcvalue;
X crcvalue:=0+CARDINAL(WShl(t,1));
X END;
X IF xin#0 THEN
X crcvalue:=CARDINAL(WEor(crcvalue,GEN1X5X12X16));
X END;
X END;
X RETURN crcvalue;
XEND crcupdate;
X
XPROCEDURE crcfinish(crcvalue: CARDINAL): CARDINAL;
XBEGIN
X RETURN CARDINAL(WAnd(crcupdate(crcupdate(crcvalue,0c),0c),0ffffH));
X
X
XEND crcfinish;
X
XPROCEDURE IAnd255(num: INTEGER): INTEGER;
XBEGIN
X RETURN INTEGER(WAnd(num,0ffH));
XEND IAnd255;
X
XPROCEDURE mdmini;
XBEGIN
X ok:=FALSE;
X xmodemerror:=0;
X xmodemabort:=FALSE;
X mtimeout:=120;
X mdmBytesXferred:=0;
X mdmPacketsSent:=0;
X mdmPacketsReceived:=0;
X mdmBadPackets:=0;
X mdmNakedPackets:=0;
XEND mdmini;
X
XPROCEDURE xmodemstat;
XBEGIN
X WriteLn;
X WriteString(" XMODEM STATUS ");
X IF rec THEN
X WriteString(" receiver active ");
X WriteString(xfrname);
X IF crcmode THEN
X WriteString(" CRC mode.");
X ELSE
X WriteString(" CHECKSUM mode.");
X END;
X END;
X IF snd THEN
X WriteString(" transmitter active ");
X WriteString(xfrname);
X IF crcmode THEN
X WriteString(" CRC mode.");
X ELSE
X WriteString(" CHECKSUM mode.");
X END;
X END;
X WriteLn;
X IF ok THEN
X WriteString(" Transfer complete. ");
X WriteLn;
X END;
X IF xmodemerror#0 THEN
X WriteString(" Transfer aborted! ");
X errorbells;
X WriteLn;
X END;
X WriteLn;
X WriteString(" Total packets sent ");
X WriteInt(mdmPacketsSent,12);
X WriteLn;
X WriteString(" Packets left ");
X WriteInt(endblk,12);
X WriteLn;
X WriteString(" Packets received ");
X WriteInt(mdmPacketsReceived,12);
X WriteLn;
X WriteString(" Bad packets ");
SHAR_EOF
echo "End of part 7, continue with part 8"
echo "8" > s2_seq_.tmp
exit 0