!
!THE SCRIPT TASK FOR SIMPLE INTERACTIVE VIDEO CLUSTER
!
!   W.S.C. MODIFIED FROM Z16301 22ND JAN 1980
!
!V001
!
!   ???   LAST UPDATE   14:3:80
!
!   THIS VERSION FOR USE WITH SIVC
!THIS TASK READS UP TO NUMSCR SCRIPT FILES FROM THE DISC
!AND SENDS SCRIPT LINES AT A GIVEN RATE TO THE TCP
!PROTOCOL HANDLER.THE TASK ASSUMES THAT TKPARN
!IS A PARAMETER FILE FROM WHICH IT READS:-
!  1)THE NUMBER OF SCRIPTS
!  2)THE % OF LINE SPEED TO BE TAKEN AS TYPING SPEED
!  3)THE TIME DELAY BETWEEN STARTING EACH SCRIPT
!  FOR EACH SCRIPT:-
!  4)SCRIPT FILE NAME,SYSTEM AND UNIT NUMBER
!  5)LINE SPEED(CHARS/SEC)
!   6)GROUP ADDRESS
!   7)TERMINAL ADDRESS
!   8)LINE NUMBER
!THE TASK HOLDS 1 SCRIPT ENTRY FOR EACH SCRIPT,
!IN A LINKED LIST OF SMALL SCRIPT BUFFERS,
!THE SUBROUTINE REDK READING NEW ENTRIES FROM THE DISC AS
!REQUIRED.FOR EACH SCRIPT FILE THERE IS A RECORD OF STATUS
!AND POINTER INFORMATION(SCSS).
!MODIFIED 'SCINIT' SEQUENCE TO REMOVE INT-L TROUBLES
!
!SCRIPT TASKS START IN SLOT 25(TSK1) AND GO
!DOWNWARDS:TSK2-24,TSK3-23 ETC.
!   THIS VERSION IS FOR CODE SHARING-ALL TASKS HAVE NAME TSK1
!
!
!INTERRUPTS FROM CONSOLE TO TSKN

!     A     ABORT IMMEDIATELY

!     L     LOOP ALL SCRIPTS AS THEY FINISH

!     ?     PRINT STATE OF SCRIPTS

!     Q     AS FOR ? WITH INTERNAL BUFFER DATA

! TO MODIFY TO ANOTHER TASK NUMBER EDIT
!     PARMF   AND   SYSLOT
!
! TO MODIFY NUMBER OF SCRIPTS EDIT NUMSCR AND SCBUFFS

!FATAL ERRORS:

!
!     -1:INTERNAL SCRIPT BUFFERS EXHAUSTED
!     -2:BAD DISC READ
!     -3:BAD DISC READ  AT START OF FILE
!     -4:SCRIPT FILE CORRUPT ON GETNEXT
!     -5:NOT USED
!     -6:NOT USED
!     -7:DISC QUEUE EXCEEDED
!     -8:PARAMETER FILE TOO SHORT
!     -9:PARAMETER FILE DISC READ ERROR
!     -10:SYMBOL IN PARAMETER DATA
!     -11:PARAMETER FILE NON EXISTANT
!     -12:CANNOT READ 1ST BLOCK OF PARAMETER FILE
!

!STACK SET TO 1000,STREAMS=0
!
!
%BEGIN
%PERMROUTINESPEC SVC(%INTEGER EP,P1,P2)
%RECORDFORMAT PF(%BYTEINTEGER SERVICE,REPLY,%INTEGER A1,%C
  %BYTEINTEGERARRAYNAME A2,%INTEGER A3)
%OWNRECORD(PF) P
%RECORDFORMAT PBF(%BYTEINTEGER SERVICE,REPLY,B1,B2,B3,B4,B5,B6)
%OWNRECORD(PBF)%NAME PB
%RECORDFORMAT P2F(%BYTEINTEGER SERVICE,REPLY,%INTEGER A1,A2,A3)
%RECORD(P2F)%NAME PZ
%CONSTBYTEINTEGERNAME INT=K'160060'
%CONSTBYTEINTEGERNAME ID=K'160030'
%CONSTBYTEINTEGER NUMSCR=16;  !MAX NO OF SCRIPTS/TASK
%RECORDFORMAT XF(%BYTEINTEGER UNIT,FSYS,%C
  %BYTEINTEGERARRAY FNAME(0:5),%BYTEINTEGER SCR)
%OWNRECORD(XF)%ARRAY SFILE(1:NUMSCR)
%OWNINTEGERARRAY LS(1:NUMSCR);  !LINE SPEEDS
%RECORDFORMAT SS(%BYTEINTEGER STATE,LEN,ESTAT,%C
   %INTEGER DEL,SCPTR,BUFS,GROUP ADDR,ADDRESS,LINE)
%OWNRECORD(SS)%ARRAY SCSS(1:NUMSCR)
%RECORD(SS)%NAME S
%OWNRECORD (XF) PARFIL
%CONSTBYTEINTEGERARRAY PARMF(0:5)='T','K','P','A','R','2'
%OWNINTEGERARRAY CC(1:NUMSCR)=0(NUMSCR)

!
!BITS FOR SCRIPT STATUS
!

%SWITCH SW(0:7)
%CONSTBYTEINTEGER WTYPE=0;  !SENDING AFTER TYPING DELAY
%CONSTBYTEINTEGER WBUFF1=1;   !WAITING FOR TCPX BUFFER(1ST REQUEST)
%CONSTBYTEINTEGER WBUFF2=2;   !WAITING FOR TCPX BUFFER(2ND REQ)
%CONSTBYTEINTEGER WSYS=3;  !WAITING FOR SYSTEM RESPONSE
%CONSTBYTEINTEGER WTHINK=4;  !WAITING FOR THINK DELAY
%CONSTBYTEINTEGER WDISC=5;   !WAITING FOR DISC TRANSFER
%CONSTBYTEINTEGER PDEL=6;  !START OF SCRIPT ENTRY STATE
%CONSTBYTEINTEGER EOS=7;  !END OF SCRIPT REACHED

!
!DISC SCRIPT STATUS INFORMATION
!

%RECORDFORMAT DKS(%INTEGER CBLK,COFF,%BYTEINTEGER NLCT,RPTR)
%OWNRECORD(DKS)%ARRAY DKSTAT(1:NUMSCR)
%OWNINTEGER S1
%OWNINTEGER CURBLK,CURUN;  !CURRENT BLOCK & UNIT IN CORE
%OWNINTEGER PARBLK,DPOS;   !CURRENT PARAMETER BLOCK & POINTER
%OWNINTEGER NSCRIP;  !NUMBER OF SCRIPTS
%OWNBYTEINTEGERARRAY DBLK(0:511);  !DISC BLOCK
%RECORDFORMAT PD(%BYTEINTEGER SERVICE,REPLY,%INTEGER A1,%C
  %RECORD(XF)%NAME X,%INTEGER A3);  !FOR DISC TASK 4 COMMUNICATION
%RECORD(PD)%NAME PX
%OWNINTEGERARRAY DKQ(1:NUMSCR);     !DISC QUEUE
%RECORD(DKS)%NAME D

!
! MAPPING FORMATS
!

%BYTEINTEGERARRAYNAME G
%RECORDFORMAT A1F(%BYTEINTEGERARRAYNAME F)
%RECORDFORMAT A2F(%INTEGER X)
%RECORD(A1F) A1
%RECORD(A2F)%NAME A2

!
!TASK CONSTANTS
!

%CONSTBYTEINTEGER DREAD=0
%CONSTBYTEINTEGERARRAY DISCRW(0:3)=3,3,8,14;  !READ/WRITE TASK
%CONSTBYTEINTEGERARRAY DISCIX(0:3)=4,4,9,15;  !DISC INTERROGATE TASK
%CONSTBYTEINTEGER DKOK=0;  !DISC ERROR RETURN
%CONSTBYTEINTEGER GETNXT=1;  !GET NEXT BLOCK PARAM
%CONSTBYTEINTEGER EXAMIN=0;  !FIND FIRST BLOCK PARAM
%CONSTBYTEINTEGER EOT=4;  !END OF SCRIPT FILE
%CONSTBYTEINTEGER LINKIN=13;  !LINKIN SVC NUMBER
%OWNINTEGER SYSLOT=24;  !SYSTEM SLOT
%CONSTBYTEINTEGER TIME SER=28;  !TIME SERVICE TASK NO
%CONSTBYTEINTEGER SIVC SER=10;   !WSC
%CONSTBYTEINTEGER INIT SER=29;  !INIT SERVICE TASK NO
%CONSTBYTEINTEGER MYSEG=4
%CONSTBYTEINTEGERNAME FSYSNO=K'160055';              !USER FILE SYSTEM NO.

!
!SCRIPT BUFFERS
!

%CONSTBYTEINTEGER SCBUFFS=50;     ! MUST BE >=NUMSCR
%CONSTBYTEINTEGER SCBUFL=15;       ! LENGTH OF BUFFER(BYTES)
%CONSTBYTEINTEGER EMARK=-1;       ! END OF LIST MARKER
%RECORDFORMAT SCB(%INTEGER PTR,%BYTEINTEGERARRAY CMD(1:SCBUFL))
%OWNRECORD(SCB)%ARRAY SCBUF(0:SCBUFFS);     !BUFFER LIST
%OWNINTEGER FREETOP=0;          !TOP OF FREE LIST

! MONITORING AIDS  ALL LINES WITH MMM

%OWNINTEGERARRAY DELAYS(1:NUMSCR)
%OWNINTEGER BUFUSD,BUFMAX;     !MMM
%OWNINTEGER TOPQ,FOOTQ,I,J,SCR,STDEL,SEG,STDEL2
%OWNINTEGER DEL,QCT,DKWAIT,SYM,TYPER

!**********************************************************************
!**********************************************************************


!*
!***   WAKE ME
!*

%ROUTINE WAKE ME
  !REQUESTS WAKE UP IN 5 SECS
  !P_A3=-1 ON RETURN
  P_SERVICE=TIME SER
  P_REPLY=ID
  P_A1=250
  P_A3=-1
  PON(P)
%END

!*
!***   GETICK
!*

%ROUTINE GETICK(%INTEGER TIM)
   !REQUESTS CLOCK TICK
   P_SERVICE=TIME SER
   P_REPLY=ID
   P_A1=TIM*50
   P_A3=SCR
   PON(P)
%END

!*
!***   REPORT
!*

!
!REPORT ROUTINE TO SEND MESSAGES BACK TO INIT.
!USED FOR FINISHED AND FATAL ERRORS.NO RETURN
!I<0 IS ERROR STATE,I=0 IS FINISH
!
%ROUTINESPEC STATUS REPORT(%INTEGER ALL)
%ROUTINE REPORT(%INTEGER I)
   %IF I#0 %THEN STATUS REPORT(1) %ELSE STATUS REPORT(0)
   P_SERVICE=INIT SER
   P_REPLY=ID
   P_A1=I
   PON(P)
   %STOP
%END

!*
!***   DKREAD
!*

%INTEGERFN DKREAD(%BYTEINTEGER DISC,%INTEGER BLOCK,WAIT)
   !
   !TO READ A BLOCK FROM THE DISC.
   !WAIT=0 DOES PON,WAIT#0 DOES PONOFF
   !RESULT IS 0 FOR PON,P_A1 FOR PONOFF
   !
   P_SERVICE=DISCRW(DISC)
   P_REPLY=ID
   P_A1=DREAD
   P_A2==DBLK
   P_A3=BLOCK
   %IF WAIT=0 %THEN PON(P) %AND %RESULT=0
   PONOFF(P)
   %RESULT=P_A1
%END


!*
!***   INQ
!*

%INTEGERFN INQ(%RECORD(XF)%NAME F,%BYTEINTEGER REQ,%C
          %INTEGER OLD,WAIT)
%%INTEGER I,J;%%%
   !
   !TO INTERROGATE THE FILE SYSTEM
   !WAIT AS ABOVE
   !
   PX_SERVICE=DISCIX(F_UNIT)
   PX_REPLY=ID
   PX_A1=REQ
   PX_X==F
   PX_A3=OLD
   %IF WAIT=0 %THEN PON(PX) %AND %RESULT=0
   PONOFF(PX)
   %RESULT=PX_A1
%END


!*
!***   READIT
!*

%ROUTINE READIT(%INTEGERNAME X,%INTEGER MODE)
   !
   !READIT READS THE PARAMETER FILE FROM TKPARN IN DBLK
   !CURRENT POSITION UN BLOCK IS DPOS.
   ! MODE=0 : RETURN INTEGER IN X
   ! MODE=N : RETURN SYMBOL IN X,SKIPPING N-1 SYMBOLS FIRST.
   !
   %OWNINTEGER I
   %ROUTINE INCPOS(%INTEGER N)
      DPOS=DPOS+N
      %IF DPOS>511 %START
         %IF INQ(PARFIL,GETNXT,PARBLK,1)=-1 %THEN REPORT(-8)
         PARBLK=PX_A1
         DPOS=DPOS-512
         %IF DKREAD(0,PARBLK,1)#DKOK %THEN REPORT(-9)
      %FINISH
   %END

   %IF MODE#0 %START
      INCPOS(MODE-1)
      X=DBLK(DPOS)
      INCPOS(1)
   %FINISH %ELSE %START
      X=0
      %WHILE DBLK(DPOS)=' ' %OR DBLK(DPOS)=NL %THEN INCPOS(1)
      %UNTIL DBLK(DPOS)=' ' %OR DBLK(DPOS)=NL %CYCLE
         I=DBLK(DPOS)-'0'
         %IF 0>I %OR 9<I %THEN %START
            %CYCLE I=0,1,511
               PRINTSYMBOL(DBLK(I))
            %REPEAT
            REPORT(-10)
         %FINISH
         X=(X*10)+I
         INCPOS(1)
      %REPEAT
   %FINISH
%END

!*
!***   STATUS REPORT
!*

%ROUTINE STATUS REPORT(%INTEGER ALL)

   !PRODUCES STATUS REPORT FOR EACH SCRIPT

   %INTEGER I,J,K
   PRINTSTRING('SCRIPT  STATE  CMDS  DEL')
   NEWLINE
   %CYCLE I=1,1,NSCRIP
      S==SCSS(I)
      WRITE(I,3)
      J=S_STATE
      WRITE(J,6)
      WRITE(CC(I),6)
      WRITE(DELAYS(I),5)
      %IF ALL=1 %START
         J=S_LEN
         WRITE(J,3)
         WRITE(S_BUFS,2)
         %IF S_BUFS>0 %START
            J=S_SCPTR
            %CYCLE K=1,1,S_BUFS
               WRITE(J,2)
               J=SCBUF(J)_PTR
            %REPEAT
         %FINISH
      %FINISH
      NEWLINE
   %REPEAT
   WRITE(BUFMAX,5);     !MMM
   NEWLINE;             !MMM

%END

!*
!**
!***   GETBUF
!**
!*

%INTEGERFN GETBUF

   !RETURNS INDEX TO THE FIRST FREE BUFFER IN THE
   !LIST OF SCRIPT BUFFERS

   %INTEGER BUF
   BUF=FREETOP
   %IF BUF#EMARK %START
      FREETOP=SCBUF(BUF)_PTR
      BUFUSD=BUFUSD+1;     !MMM
      S_BUFS=S_BUFS+1
      %IF BUFUSD>BUFMAX %THEN BUFMAX=BUFUSD;     !MMM
   %FINISH
   %RESULT=BUF
%END

!*
!**
!***   RELBUF
!**
!*

%ROUTINE RELBUF(%INTEGER IND)

   !RETURNS BUFFER INDEXED BY IND TO THE FREE LIST

   SCBUF(IND)_PTR=FREETOP
   FREETOP=IND
   BUFUSD=BUFUSD-1;     !MMM
   S_BUFS=S_BUFS-1
%END

!*
!**
!***   COPY COMMAND
!**
!*

%ROUTINE COPY COMMAND

   !THIS COPIES THE COMMAND LINE FROM THE SCRIPT BUFFERS
   !POINTED TO BY S_SCPTR INTO THE MAPPED ARRAY G.
   !IT THEN RELEASES THE BUFFERS.

   %INTEGER I,J
   I=1
   J=1
   %WHILE I<=S_LEN %CYCLE
      G(I-1)=SCBUF(S_SCPTR)_CMD(J)
      %IF J=SCBUFL %THEN %START
         %IF I<S_LEN %START

         !GET NEXT BUFFER IN CHAIN

            J=S_SCPTR
            S_SCPTR=SCBUF(S_SCPTR)_PTR
            RELBUF(J)
            J=1
         %FINISH
      %FINISH %ELSE J=J+1
      I=I+1
   %REPEAT
   RELBUF(S_SCPTR);      !RELEASE LAST BUFFER
   S_SCPTR=-1;           !RESET POINTER
   CC(SCR)=CC(SCR)+1;    !COMMAND COUNT FOR STATUS REPORT
%END



!**********************************************************
!**********************************************************
!**********************************************************

!
!***************     REDK     ********************

!REDK  DISC READ ROUTINE

!     THIS ROUTINE IS CALLED TO GET THE NEXT COMMAND LINE
!ETC FROM A SCRIPT FILE AND PUT IT INTO SCRIPT BUFFER FROM
!THE LIST SCBUF.IT HAS TWO PARAMETERS

!     1)THE SCRIPT NUMBER(FOR EVENT 1 ONLY)

!     2)AN EVENT NUMBER AS FOLLOWS:-

!          1 : READ NEXT SCRIPT ENRTY REQUEST

!          2 : MESSAGE FROM DISC HANDLER THAT BLOCK HAS ARRIVED

!          3 : MESSAGE THAT OVERFLOW BLOCK NUMBER IS KNOWN

!     THE ROUTINE MAINTAINS THE STATUS OF EACH SCRIPT FILE IN
!THE RECORD DKSTAT,IE. NEXT BLOCK NUMBER AND A POINRTER TO
!THE NEXT ENTRY.IF AN ENTRY IS HELD OVER A BLOCK BOUNDARY ALL
!REQUESTS ARE QUEUED UNTIL THE NEXT BLOCK IS FOUND AND THE FIRST
!REQUEST SATISFIED.

!     THE ROUTINE REQUESTS SCRIPT BUFFERS AS REQUIRED;!WHEN
!THERE ARE NONE LEFT ALL DISC REQUESTS ARE QUEUED UNTIL ONE
!COMES FREE.

%ROUTINE REDK(%INTEGER SCRNO,TYPE)

   %OWNINTEGER DISCS,CSCBUF,CPTR,CLINE,RS,TEMP
   %SWITCH TY(1:4)
   %CONSTBYTEINTEGER BUSY=1
   %CONSTBYTEINTEGER FREE=0

   !
   !DISC QUEUE ROUTINES
   !

   %ROUTINE PUTONQ(%INTEGER SCRIPT)
      %IF QCT=NUMSCR %THEN REPORT(-7);   !DISC Q FULL
      DKQ(FOOTQ)=SCRIPT
      QCT=QCT+1
      %IF FOOTQ=NUMSCR %THEN FOOTQ=1 %ELSE FOOTQ=FOOTQ+1
   %END

   %ROUTINE OFFQ
      DKQ(TOPQ)=0
      QCT=QCT-1
      %IF TOPQ=NUMSCR %THEN TOPQ=1 %ELSE TOPQ=TOPQ+1
   %END

   !
   ! SWITCH HERE ON REQUEST TYPE
   !

   ->TY(TYPE)

   !*
   !*** TYPE=1  :  REQUEST FOR NEXT SCRIPT ENTRY
   !*

   TY(1):

      PUTONQ(SCRNO)
      %RETURN %IF DISCS=BUSY

      !NOT BUSY SO SET UP NEXT READ

      NEXTONQ:

         SCR=DKQ(TOPQ);     !SCRIPT NUMBER
         %RETURN %IF SCR=0; !Q EMPTY
         DISCS=BUSY
         D==DKSTAT(SCR);    !SCRIPT FILE STATUS
         S==SCSS(SCR);         !SCRIPT STATUS
         CPTR=SCBUFL+1;        !POINTER TO SCRIPT BUFFER
         CLINE=1;              !LINE 1 OF SCRIPT ENTRY
         S_LEN=0;              !LENGTH OF COMMAND LINE
         %IF D_CBLK=CURBLK %AND %C
            SFILE(SCR)_UNIT=CURUN %THEN ->INCORE

         !BLOCK NOT IN CORE

         GETBLK:

            TEMP=D_CBLK
!            %IF SFILE(SCR)_UNIT=1 %THEN TEMP=TEMP!K'020000'
            TEMP=DKREAD(SFILE(SCR)_UNIT,TEMP,0)
            %RETURN

   !*
   !***   TYPE=2  :  BLOCK HAS ARRIVED IN CORE
   !*

   TY(2):

      %IF P_A1#DKOK %THEN REPORT(-2);     !DISC ERROR

      INCORE:

         SCR=DKQ(TOPQ);          !SCRIPT NO
         D==DKSTAT(SCR);         !SCRIPT FILE STATUS
         CURBLK=D_CBLK;          !CURRENT FILE AND UNIT
         CURUN=SFILE(SCR)_UNIT;  !NO IN CORE
         S==SCSS(SCR);           !SCRIPT STATUS

      NEXTCHAR:

         D_COFF=D_COFF+1;        !NEXT CHAR IN DISC BUFFER
         %IF D_COFF=512 %START

            !DISC BLOCK OVERFLOW-GET NEXT BLOCK NUMBER

            D_COFF=-1
            TEMP=INQ(SFILE(SCR),GETNXT,CURBLK,0)
            %RETURN;             !WILL RE-ENTER AS TYPE 3
         %FINISH

      !S_LEN IS THE CHARACTER COUNT IN THE COMMAND LINE
      !SO FAR-IT STARTS AT 0.IF WE HAVE REACHED THE END
      !OF A SCRIPT BUFFER THE POINTER CPTR WILL BE
      !SCBUFL+1,BUT ONLY IF WE ARE STILL ON THE COMMAND
      !LINE(CLINE=1).

      COPYCHAR:

         %IF CLINE=1 %START
            %IF CPTR=SCBUFL+1 %START

               !NEED A NEW SCRIPT BUFFER

               TEMP=GETBUF
               %IF TEMP=EMARK %START

                  !NO MORE SCRIPT BUFFERS

                  REPORT(-1);     !FATAL IF NO BUFFERS
               %FINISH

               !LINK NEW BUFFER IN

               %IF S_SCPTR=-1 %THEN S_SCPTR=TEMP %ELSE %C
                  SCBUF(CSCBUF)_PTR=TEMP
               CSCBUF=TEMP;        !CURRENT SCRIPT BUFFER
               CPTR=1;             !POINTER TO ARRAY IN BUFFER
            %FINISH

            !COPY CHARACTER INTO SCRIPT BUFFER

            SCBUF(CSCBUF)_CMD(CPTR)=DBLK(D_COFF)
            CPTR=CPTR+1
            S_LEN=S_LEN+1
            %IF DBLK(D_COFF)=NL %THEN CLINE=2
            %IF DBLK(D_COFF)=EOT %THEN CLINE=4
            ->NEXTCHAR %UNLESS CLINE=4
         %FINISH

         !IF CLINE=2 THIS IS THE CHECK LINE SO SKIP
         !UNTIL THE NL
         !IF CLINE=3 THIS IS THE DELAY TIME.WORK IT OUT
         !AND SAVE IN S_DEL.PRECEDING SPACES ARE REMOVED

         %IF CLINE=3 %OR CLINE=4 %START
            %IF (RS=1 %AND DBLK(D_COFF)#NL) %C
              %OR (RS=0 %AND '0'<=DBLK(D_COFF)<='9') %START
               TEMP=S_DEL;     !COMPILER BUG
               TEMP=TEMP*10
               S_DEL=TEMP
               S_DEL=S_DEL+(DBLK(D_COFF)-'0')
               RS=1
            %FINISH
            %IF CLINE=4 %OR (RS=1 %AND DBLK(D_COFF)=NL) %START

               !END OF SCRIPT ENTRY REACHED

               OFFQ
               DISCS=FREE
               S_ESTAT=0;       !SCRIPT ENTRY READY
               %IF S_STATE=WDISC %THEN GETICK(0)
               ->NEXTONQ
            %FINISH
         %FINISH
         %IF CLINE=2 %AND DBLK(D_COFF)=NL %START
            RS=0;       !REDUNDANT SPACES FLAG
            CLINE=3;    !NOW ON LINE 3
         %FINISH
         ->NEXTCHAR

      !*
      !***  TYPE=3  :  OVERFLOW BLOCK NUMBER FOUND
      !*

      TY(3):

         !THE BLOCK NUMBER OF THE NEXT BLOCK OF THE SCRIPT
         !FILE IS IN P_A1.IT WILL BE READ INTO CORE AS PART
         !OF THE TYPE 1 SEQUENCE.

         %IF P_A1=-1 %THEN REPORT(-4);      !CORRUPT FILE
         SCR=DKQ(TOPQ)
         D==DKSTAT(SCR)
         D_CBLK=P_A1
         %IF D_CBLK=0 %START

            !END OF FILE REACHED

            DBLK(1)=EOT
            ->INCORE
         %FINISH
         ->GETBLK

%END

!***************************************************
!***************************************************
!***************************************************


!  ROUTINE SCINIT    SCRIPT INITIALISE


%ROUTINE BSCINIT(%INTEGER I)

!SET UP INITIAL BUFFEER & POINTER STATES

  SFILE(I)_SCR=I;          !SCRIPT NUMBER
  DKSTAT(I)_CBLK=-1;       !CURRENT BLOCK IN CORE
  DKSTAT(I)_COFF=-1;       !CURRENT BLOCK ON DISC
  DKSTAT(I)_RPTR=1;        !ENTRY POINTER
  DKSTAT(I)_NLCT=0;        !NEWLINE COUNT
  SCSS(I)_STATE=PDEL;      !INITIAL STATE
  SCSS(I)_SCPTR=-1;        !POINTER TO SCRIPT BUFFER
  SCSS(I)_BUFS=0;         !NUMBER OF BUFFERS ALLOCATED

  !GET FIRST BLOCK NUMBER FOR THIS SCRIPT
  !BLOCK NUMBER IN P_A1

  %IF INQ(SFILE(I),EXAMIN,0,1)=0 %THEN REPORT(-3)
  DKSTAT(I)_CBLK=P_A1
  CURBLK=0;              !FORCE A READ
  REDK(I,1);           !FIRST ENTRY
!
%END     ;!RT BSCINIT


!   ROUTINE SCINIT IS ONLY USED AT START UP
!   ROUTINE BSCINIT IS USED WHEN INT-L ING

%ROUTINE SCINIT(%INTEGER I)

!   USED AT START UP TO AVOID SWAMPING

   BSCINIT(I)
   P_SERVICE=0
   POFF(P)
   REDK(0,2)
!
%END     ;!RT SCINIT

!**************************************************************
!**************************************************************


!
!SCRIPT INITIALISATION
!

SVC(LINKIN,SYSLOT,0)
SVC(18,1,0);           !SET PRIORITY TO 1
PZ==P
PB==P
PX==P
A2==A1
PARFIL_UNIT=0;PARFIL_FSYS=FSYSNO;                  !TKPAR FILE IN OWN FILE SYSTEM
%CYCLE I=0,1,5
   PARFIL_FNAME(I)=PARMF(I)
%REPEAT

!
!INITIALISE SCRIPT BUFFER LIST
!

%CYCLE I=0,1,SCBUFFS-1
   SCBUF(I)_PTR=I+1
%REPEAT
SCBUF(I+1)_PTR=EMARK

!
! GET FIRST BLOCK INTO DBLK
!

%IF INQ(PARFIL,EXAMIN,0,1)=0 %THEN REPORT(-11)
PARBLK=P_A1
DPOS=0
%IF DKREAD(0,PARBLK,1)#DKOK %THEN REPORT(-12)

READIT(STDEL2,0);            !IN MINS
READIT(NSCRIP,0);  !NUMBER OF SCRIPTS
READIT(TYPER,0);  !%OF LINE SPEED FOR TYPING RATE
READIT(STDEL,0);   !STARTUP DELAY TIME
TOPQ=1;FOOTQ=1
DKWAIT=0
CURUN=0
CURBLK=0

!
!TELL INIT THE NO OF SCRIPTS
!

P_SERVICE=INIT SER
P_REPLY=ID
P_A1=NSCRIP
P_A3=-111
PON(P)
!      INITIAL START UP DELAY

%IF STDEL2>0 %START
   %CYCLE I=1,1,STDEL2
      P_SERVICE=TIME SER
      P_REPLY=ID
      P_A1=3000
      PONOFF(P)
   %REPEAT
%FINISH

!GET EACH SCRIPT'S PARAMETERS

%CYCLE I=1,1,NSCRIP
   S==SCSS(I)
   READIT(SYM,1)
   %CYCLE J=0,1,5;  !SCRIPT FILE NAME
      READIT(SYM,1)
      SFILE(I)_FNAME(J)=SYM
   %REPEAT
   READIT(SYM,0);  !FILE SYSTEM
   SFILE(I)_FSYS=SYM
   READIT(SYM,0);  !UNIT
   SFILE(I)_UNIT=SYM;  !
   READIT(LS(I),0);  !LINE SPEED
   READIT(S_GROUP ADDR,0);     !WSC 22/1/80
   READIT(S_ADDRESS,0);        !WSC
   READIT(S_LINE,0)
   
  !SEND LINE SPEED TO HÁNDL]×*!  
   PB_SERVICE=SIVC SER;PB_REPLY=ID
   PB_B1=0; PB_B2=S_LINE;     !WSC 22/1/80
   PB_B3=LS(I)//10
   PB_B4=S_GROUP ADDR
   PB_B5=I; PB_B6=S_ADDRESS
   PON(PB)

%REPEAT

!
!NOW GET FIRST ENTRIES IN EACH SCRIPT FILE
!(TAKEN OUT OF ABOVE CYCLE TO AVOID DBLK CLASH)
!

%CYCLE I=1,1,NSCRIP
   SCINIT(I)
   %CYCLE J=1,1,10000;  ! DELAY A LITTLE
      SYM=SYM+1
   %REPEAT
%REPEAT

!
!ALL SCRIPTS NOW INITIALISED.
!SEND OFF START REQUESTS TO TIME
!

%CYCLE I=1,1,NSCRIP
   P_SERVICE=TIME SER
   P_REPLY=ID
   P_A1=(((I-1)*STDEL)*50)+1
   P_A3=I
   PON(P)
%REPEAT

WAKE ME

!*****************************************************
!*****************************************************

!MAIN SCRIPT CONTROL LOOP

SLOP:
%IF INT='?' %START
   STATUS REPORT(0)
   INT=0
%FINISH

%IF INT='Q' %START
   STATUS REPORT(1)
   INT=0
%FINISH

%IF INT='A' %THEN ->SLOP2

%IF INT='L' %START
  !LOOPING
  %CYCLE I=1,1,NSCRIP
    %IF SCSS(I)_STATE=EOS %START
      !
      !RESTART SCRIPT AFTER 5 SEC
      !IF DISC BLOCK NOT IN IN THIS TIME THEN TROUBLE
      !
      BSCINIT(I)
      P_SERVICE=TIME SER
      P_REPLY=ID
      P_A1=250
      P_A3=I
      PON(P)
      ->SLOP1;                      !ONLY 1 START UP AT A TIME
    %FINISH
  %REPEAT
  ->SLOP1
%FINISH

!NOT ABORTED OR LOOPING

%CYCLE I=1,1,NSCRIP
  %IF SCSS(I)_STATE#EOS %THEN ->SLOP1
%REPEAT

!
!ALL SCRIPTS FINISHED
!

SLOP2:

P_SERVICE=SIVC SER;        !TELL SIVC TO STOP THESE TERMINALS
P_REPLY=ID; PZ_A2=-1
PZ_A1=-1
PON(P)

REPORT(0)

!*
!***   WAITS HERE FOR SOMETHING TO HAPPEN
!*

SLOP1:P_SERVICE=0
POFF(PX);  !WAIT FOR AN EVENT

!*
!**
!*****     DISC EVENT
!**
!*

%CYCLE I=0,1,3
%IF P_REPLY=DISCRW(I) %THEN %START
                     !DISC READ CALL TYPE 2
  REDK(0,2)
  ->SLOP
  %FINISH
%REPEAT

!*
!**
!*****     FILE SYSTEM EVENT
!**
!*

%CYCLE I=0,1,3
%IF P_REPLY=DISCIX(I) %START
                     !OVERFLOW BLOCK FOUND-CALL TYPE 3
  REDK(0,3)
  ->SLOP
  %FINISH
%REPEAT

!*
!**
!*****     TIMER EVENT
!**
!*

%IF P_REPLY=TIME SER %START

   !IF P_A3=-1  THIS IS WAKE UP TO LOOK AT INT

   %IF P_A3=-1 %START
      WAKE ME
      ->SLOP
   %FINISH

   !GENUINE CLOCK EVENT
   !P_A3 HAS SCRIPT NUMBER

   SCR=P_A3
   S==SCSS(SCR)

   ->SW(S_STATE)

   !*
   !***  STATE=WTYPE OR WBUFF2
   !*

   SW(WTYPE):
   SW(WBUFF2):

      !REQUEST BUFFER FROM TCPX TO SEND LINE

      PZ_SERVICE=SIVC SER
      PZ_REPLY=ID
      PZ_A1=-1
      PZ_A3=SCR
      PON(PZ)
      S_STATE=WBUFF1
      ->SLOP

   !*
   !***  STATE=PDEL
   !*

   SW(PDEL):

      !CALCULATE TYPING DELAY

      P_SERVICE=TIME SER
      P_REPLY=ID
      P_A1=((S_LEN*100)//(LS(SCR)*TYPER))*50
      P_A3=SCR
      PON(P)
      S_STATE=WTYPE
      ->SLOP

   !*
   !***  STATE=WTHINK
   !*

   SW(WTHINK):

      !SEE IF NEXT ENTRY IS READY

      %IF S_ESTAT=1 %START
         S_STATE=WDISC
         DELAYS(SCR)=DELAYS(SCR)+1
         ->SLOP
      %FINISH

   !*
   !***  STATE=WDISC
   !*

   SW(WDISC):

      !N.B. DROPS IN HERE NORMALLY FROM WTHINK
      !NEXT ENTRY IS IN CORE SO GO!

      %IF SCBUF(S_SCPTR)_CMD(1)=EOT %START
         RELBUF(S_SCPTR)
         S_STATE=EOS
         ->SLOP
      %FINISH
      S_STATE=PDEL
      ->SW(PDEL)

%FINISH

!*
!**
!*****     TCPX RESPONSE EVENT
!**
!*

SCR=P_A3
S==SCSS(SCR)

!*
!**   CHECK CURRENT STATE IS CONSISTENT WITH MESSAGE FROM TCPX
!*

%IF S_STATE#WBUFF1 %THEN %START
   %IF S_STATE#WBUFF2 %THEN %START
      %IF S_STATE#WSYS %THEN ->SLOP     ;!AVOID SCREW UPS
   %FINISH
%FINISH
!
->SW(S_STATE)

   !*
   !***  STATE=WBUFF1
   !*

   SW(WBUFF1):

      !REPLY TO BUFFER REQUEST
      !P_A1<0 MEANS NO BUFFERS
      !P_A1>0 MEANS THERE HAS BEEN A SLIGHT SCREW UP - IGNORE IT

      %IF P_A1>0 %THEN ->SLOP;          !EXTRA PROMPT ?
      %IF P_A1<0 %START
         S_STATE=WBUFF2
         GETICK(1);         !TRY AGAIN IN 1 SEC
         ->SLOP
      %FINISH

      !PZ_A2=BUFFER ADDRESS
      !MAP IT ONTO SEGMENT 4

      SEG=PZ_A2>>13
      MAPVIRT(PZ_REPLY,SEG,MYSEG)
      A2_X=(MYSEG<<13)+(PZ_A2&K'17777')
      G==A1_F

      !COPY COMMAND LINE INTO ARRAY G

      COPY COMMAND
      MAPVIRT(0,-1,MYSEG)

      !TELL TCPX THE BUFFER IS READY

      PZ_SERVICE=SIVC SER
      PZ_REPLY=ID
      PZ_A1=S_LEN
      PZ_A3=SCR
      PON(PZ)

      !NOW WAIT FOR SYSTEM

      S_ESTAT=1
      S_STATE=WSYS
      ->SLOP

   !*
   !*** STATE=WSYS
   !*

   SW(WSYS):

      !SYSTEM RESPONSE

      S_STATE=WTHINK
      GETICK(S_DEL)
      S_DEL=0

      !REQUEST NEXT SCRIPT ENTRY FROM DISC

      REDK(SCR,1)
      ->SLOP

%ENDOFPROGRAM