!*
!* OPER37 - 2nd April 1982 *
!*
!* Communications record format - extant from CHOPSUPE 22A onwards *
!*
%RECORDFORMAT COMF(%INTEGER OCPTYPE,SLIPL,SBLKS,SEPGS,NDISCS,DLVNADDR, %C
         (%INTEGER GPCTABSIZE,GPCA %OR %INTEGER DCUTABSIZE,DCUA), %C
         %INTEGER SFCTABSIZE,SFCA,SFCK,DIRSITE,  %C
         DCODEDA,SUPLVN,TOJDAY,DATE0,DATE1,DATE2,  %C
         TIME0,TIME1,TIME2,EPAGESIZE,USERS,CATTAD,SERVAAD,  %C
         %BYTEINTEGER NSACS,RESV1,SACPORT1,SACPORT0, %C
         NOCPS,RESV2,OCPPORT1,OCPPORT0,%INTEGER ITINT,CONTYPEA, %C
         (%INTEGER GPCCONFA %OR %INTEGER DCUCONFA), %C
         %INTEGER FPCCONFA,SFCCONFA,BLKADDR,RATION, %C
         (%INTEGER SMACS %OR %INTEGER SCUS), %C
         %INTEGER TRANS,%LONGINTEGER KMON,  %C
         %INTEGER DITADDR,SMACPOS,SUPVSN,PSTVA,SECSFRMN,SECSTOCD, %C
         SYNC1DEST,SYNC2DEST,ASYNCDEST,MAXPROCS,INSPERSEC,ELAPHEAD, %C
         COMMSRECA,STOREAAD,PROCAAD,SFCCTAD,DRUMTAD,TSLICE,FEPS,  %C
         MAXCBT,PERFORMAD,SP1,SP2,SP3,SP4,SP5,SP6, %C
         LSTL,LSTB,PSTL,PSTB,HKEYS,HOOT,SIM,CLKX,CLKY,CLKZ,  %C
         HBIT,SLAVEOFF,INHSSR,SDR1,SDR2,SDR3,  %C
         SDR4,SESR,HOFFBIT,BLOCKZBIT,BLKSHIFT,BLKSIZE,END)
!*
%CONSTRECORD(COMF)%NAME COM=X'80000000'!48<<18
!*
%CONSTINTEGER SDIAGS=NO;                ! YES for cyclic CC trace
%IF MONLEVEL>>1&1=YES %START
   %EXTRINSICLONGINTEGER KMON
   %OWNINTEGER OPMON;                   ! copy of KMON bit
   %CONSTINTEGER KMONNING=YES
%FINISH %ELSE %START
   %CONSTINTEGER KMONNING=NO
%FINISH
!*
%IF MONLEVEL&1=YES %START
   %CONSTINTEGER VIDEO UPDATING=YES
   %OWNINTEGER OPER FACILITIES
%FINISH %ELSE %START
   %CONSTINTEGER VIDEO UPDATING=NO
%FINISH
!*
%RECORDFORMAT PF(%INTEGER DEST,SRCE,P1,P2,P3,P4,P5,P6)
%RECORDFORMAT MP F(%INTEGER DEST,SRCE,%STRING(23)TXT)
!*
%EXTERNALROUTINESPEC DUMPTABLE(%INTEGER X,A,S)
%EXTERNALROUTINESPEC PON(%RECORD(PF)%NAME P)
%EXTERNALROUTINESPEC PKMONREC(%STRING(20)TXT,%RECORD(PF)%NAME P)
%EXTERNALROUTINESPEC PARSE COM(%INTEGER SRCE,%STRINGNAME S)
%EXTERNALROUTINESPEC RETURN PP CELL(%INTEGER CELL)
%EXTERNALINTEGERFNSPEC STOI(%STRINGNAME S)
%EXTERNALSTRINGFNSPEC HTOS(%INTEGER N,L)
%EXTERNALSTRINGFNSPEC STRINT(%INTEGER I)
%IF SSERIES=YES %START
   %EXTERNALINTEGERFNSPEC REALISE(%INTEGER AD)
%FINISH
%SYSTEMROUTINESPEC ITOE(%INTEGER A,S)
%SYSTEMROUTINESPEC ETOI(%INTEGER A,S)
%SYSTEMROUTINESPEC MOVE(%INTEGER S,FROM,TO)
%EXTERNALINTEGERFNSPEC NEW PP CELL
%EXTRINSICLONGINTEGER PARM DES
%ROUTINESPEC DISPLAY TEXT(%INTEGER WHICH,I,J,%STRING(41)TXT)
%ROUTINESPEC OPMESS3(%STRING(63)S)
!*
%RECORDFORMAT BILL F(%INTEGER DEST,SRCE, %C
   %BYTEINTEGER LINE,POS,ZERO,%STRING(20)TXT)
%RECORDFORMAT BUFFER F(%INTEGER STREAM NO, %C
   EXTERNAL STREAM NO,AMTX,OFFSET,LENGTH, %C
   REAL ADDRESS,P5,P6,LINK)
%OWNRECORD(BUFFER F)%ARRAYFORMAT BUFFERS F(0:4095)
%RECORDFORMAT DEVICE ENTRY F(%INTEGER BUFF S, %C
      X1,X2,X3,X4,X5,X6,X7, %C
      BUFF A,SCREEN DESC)
%RECORDFORMAT IP F(%HALFINTEGER %C
   IN STRM, IN CELL, IN P2, IN P3, %C
   OUTSTRM, OUTCELL, OUTP2, OP, %C
   %INTEGER CURSOR, %C
   STATE)
%RECORDFORMAT PICTURE F(%INTEGER LENGTH,UPDATED,DATA)
%RECORDFORMAT PP CELL F(%RECORD(PF) P,%INTEGER LINK)
%OWNRECORD(PP CELL F)%ARRAYFORMAT PP CELLS F(0:4095)
%IF SSERIES=YES %START
   %RECORDFORMAT TCBF(%INTEGER COMMAND,STE,LEN,DATAD,NTCB,RESP, %C
            %INTEGERARRAY PREAMBLE,POSTAMBLE(0:3))
%FINISH %ELSE %START
   %RECORDFORMAT RCB F(%INTEGER FLAGS,LSTBA,LBS,LBA, %C
      ALS,ALA,X1,X2)
%FINISH
%RECORDFORMAT SCREEN F(%INTEGER ID, %C
   LENGTH, %C
   HL CURSOR, %C
   PICTURE A,CURSOR,SIZE,CNTRL, %C
   %BYTEINTEGER CODE, X, Y, WRITE PENDING)
%RECORDFORMAT STREAM F(%HALFINTEGER STREAM NO,%C
   EXTERNAL STREAM NO, %C
   %BYTEINTEGER STATE,MODE,ADAPTOR NO,DEVICE NO, %C
   %INTEGER LENGTH,OWNER,CALLER,AMTX,START,CURSOR,LINK)
%OWNRECORD(STREAM F)%ARRAYFORMAT STREAMS F(0:4095)
%IF SSERIES=YES %START
   %RECORDFORMAT UNIT F(%RECORD(TCBF) TCB1,TCB2,TCB3,TCB4, %C
            %INTEGER BUFFER A,CALLER,READ Q, %C
            %BYTEINTEGER INPUT ENABLED,INPUT MODE, %C
               COMMAND PENDING,ENTER PENDING,READ PENDING, %C
                  BUFF STATE,SNO,STATE, %C
                     %STRING(35) PROMPT, %C
                     %STRING(127) INPUT LINE, %C
                        %RECORD(SCREEN F)%ARRAY SCREEN(0:3))
   %CONSTINTEGER UREC SPACE=576
%FINISH %ELSE %START
   %RECORDFORMAT UNIT F(%RECORD(RCB F) RCB, %C
      %INTEGER ALE0S,ALE0A,ALE1S,ALE1A,ALE2S,ALE2A, %C
               BUFFER A,CALLER,READ Q, %C
      %BYTEINTEGER INPUT ENABLED,INPUT MODE, %C
         COMMAND PENDING,ENTER PENDING,READ PENDING, %C
         BUFF STATE, %C
         SNO,STATE, %C
      %STRING(35)PROMPT, %C
      %STRING(127)INPUT LINE, %C
      %RECORD(SCREEN F)%ARRAY SCREEN(0:3))
   %CONSTINTEGER UREC SPACE=384
%FINISH
%CONSTRECORD(BUFFER F)%ARRAYNAME BUFFERS=PARM0AD
%CONSTRECORD(PP CELL F)%ARRAYNAME PP CELLS=PARM0AD
%CONSTRECORD(STREAM F)%ARRAYNAME STREAMS=PARM0AD
%OWNRECORD(PICTURE F)%NAME OPERLOG
%OWNRECORD(PICTURE F)%NAME PROCESS LIST
%CONSTINTEGER IPL = 16
%OWNRECORD(IP F)%ARRAY IPS(1:IPL)
%OWNINTEGERARRAY RESIDENT PICTURE(0:7)
      ! 0 OPERLOG
      ! 1 PROCESS LIST
      ! 2 SPOOLR
      ! 3 VOLUMS
!
%OWNINTEGERARRAY CONTEXT(0:7)
%OWNBYTEINTEGERARRAY OPONOFF(0:7)
%CONSTBYTEINTEGER ON=0,OFF=1
!*
%IF SSERIES=YES %START
   %CONSTINTEGER INPUT=0
   %CONSTINTEGER OUTPUT=1
   %OWNINTEGER SINIT=0
%FINISH %ELSE %START
   %OWNINTEGER INPUT
   %OWNINTEGER OUTPUT
%FINISH
%OWNBYTEINTEGERARRAY SVPICS(0:2047); ! semi temporary home for SPOOLR and VOLUMS pics
!
%CONSTINTEGER ATTENTION = 1
%CONSTINTEGER BEING FILLED = 4
%OWNINTEGER   CLEAR3 = X'40151515'; ! EBCDIC SP and 3 NLS
%CONSTINTEGER COM LIMIT = 1
%CONSTINTEGER COMMAND = X'2000'
%CONSTINTEGER COMMANDED = 0
%CONSTINTEGER CONNECTING = 2
%CONSTINTEGER DISCONNECTING = 1
%CONSTINTEGER EBCDIC = 1
%CONSTINTEGER EMPTY = 0
%CONSTINTEGER ENABLING = 7
%CONSTINTEGER ENTER = X'8000'
%CONSTINTEGER EXECUTE=X'30000C'
%CONSTINTEGER EX REPLY=X'320003'
%CONSTINTEGER FFFF=X'FFFF'
%CONSTINTEGER FIRST PART = 1
%CONSTINTEGER FULL = 3
%CONSTINTEGER HDR S = 8
%CONSTINTEGER IDLE = 0
%CONSTINTEGER ISO = 0
%OWNINTEGER LAST PROC
%OWNINTEGER   LAST3C = X'15030000'; ! LINE 21 FOR 3 LINES
%OWNINTEGER   LINE21C = X'15000000'; ! LINE 21 FOR 1 LINE
%CONSTINTEGER NORMAL = 8
%CONSTINTEGER PGB = X'0100'
%CONSTINTEGER PGF = X'1000'
%CONSTINTEGER PROMPT ISSUED = 3
%CONSTINTEGER READ ISSUED = 1
%CONSTINTEGER REQUESTED = 1
%CONSTINTEGER RESIDENT = 64
%CONSTINTEGER SECOND PART = 2
%CONSTINTEGER SLOW WRITE ISSUED = 4
%CONSTINTEGER STILL BEING FILLED = 5
%CONSTINTEGER TOP BIT = X'80000000'
%CONSTINTEGER WRITE ISSUED = 2
!*
%CONSTINTEGERARRAY CONTROL WORDS(0:3) = %C
   X'00140000', X'20180000', X'40180000', X'60180000'
!  SCR0 21L     SCR1 24L     SCR2 24L     SCR3 24L
!
%IF SSERIES=YES %START
   %OWNINTEGER INIT DATA=X'0000FF00'
%FINISH %ELSE %START
   %CONSTINTEGERARRAY IN LBE(0:3) = %C
      X'04F00204', X'84E00100', X'84E00500', X'80E00302'
   !  READ(ALE2,40 BYTES TO INPUT LINE) INITIALISE   WRITE CONTROL(ALE0) WRITE(ALE1)
   %CONSTINTEGERARRAY OUT LBE(0:3) = %C
      X'04010800', X'84E00100', X'84E00500', X'80E00302'
   !  CONNECT      INITIALISE etc
%FINISH
!*
%CONSTBYTEINTEGERARRAY BLANKLINE(0:40) = 64(40), 21
%CONSTBYTEINTEGERARRAY MINUSLINE(0:40) = 96(40), 21
%CONSTSTRING(6)%ARRAY OP COMMAND(1:COM LIMIT) = %C
      "??"
%CONSTBYTEINTEGERARRAY KYNL(0:1) = 1,10
%CONSTBYTEINTEGERARRAY SNLS(0:2) = 2,133,133
%OWNSTRING(8)COMMANDP = E"COMMAND:"
%CONSTSTRING(4)LPSV = "LPSV"
%CONSTSTRINGNAME TIME = X'80C0004B', DATE = X'80C0003F'
!*
%IF SDIAGS=YES %START
   %OWNRECORD(PF)%ARRAY CCT BUFFER(0:127)
   %OWNINTEGER CCTBPTR=0,CCTSEMA=-1
   %IF MULTI OCP=YES %START
      %EXTERNALROUTINESPEC SEMALOOP(%INTEGERNAME SEMA,%INTEGER PARM)
   %FINISH
   %ROUTINE CC TRACE(%RECORD(PF)%NAME P);  ! TRACE CC ACTIVITY
   %IF MULTI OCP=YES %START
      *INCT_CCTSEMA
      *JCC_8,<CCTSEMAGOT>
      SEMALOOP(CCTSEMA,0)
   CCTSEMAGOT:
   %FINISH
   CCTBUFFER(CCTBPTR)<-P
   CCTBPTR=(CCTBPTR+1)&127
   %IF MULTI OCP=YES %START; *TDEC_CCTSEMA; %FINISH
   %END
%FINISH
!*
%ROUTINE DO PON(%RECORD(PF)%NAME P)
      PON(P)
      %IF SDIAGS=YES %AND P_DEST>>16=X'37' %THEN CC TRACE(P)
      %IF KMONNING=YES %START
         PKMONREC("OPER PONS",P) %IF OPMON=YES
      %FINISH
%END; ! OF DO PON
!*
%ROUTINE REPLY(%INTEGER DEST,%STRING(63)TXT)
%RECORD(PF) Q
      Q=0
      Q_DEST=DEST
      LENGTH(TXT)=23 %IF LENGTH(TXT)>23
      STRING(ADDR(Q_P1))=TXT
      DO PON(Q)
%END; ! OF REPLY
!*
%ROUTINE REPORT(%STRING(63)TXT)
      PRINTSTRING("**OPER ".TXT."
")
%END; ! OF REPORT
!*
                                        ! called to sort out contents of a comms
                                        ! buffer into an op buffer for display
                                        ! I is place after last ch in buffer
                                        ! A0 and A1 are first and last addrs in comms buffer
                                        ! (which is of of course circular)
                                        ! B0 is the start of the op buffer
                                        ! LIM is no of lines reqd
                                        ! SCREEN_CURSOR = N*(21*41) where N <= 0
                                        ! indicates which frame is required
%ROUTINE FORMAT(%INTEGER I,A0,A1,B0,LIM,CURS)
%INTEGERARRAY START, FINIS(1:21)
%INTEGER N, I0, IL, CH, BL, SIZE
%INTEGER C, P, F, F REQD, S, ISTART
%INTEGER A, B, L, X, Y
%STRING(63)LINE
      -> START HERE
STACK:
                                        ! given a line fragment (A,B), not 'NORMALISED',
                                        ! records it in START and FINIS arrays, incrementing
                                        ! array index N and frame no F (0,1,,,,)
      A=A-SIZE %IF A>A1
      B=B-SIZE %IF B>A1
      %IF N>LIM %START
         F=F+1
         ->OUT %IF F>F REQD
         N=0
      %FINISH
      N=N+1
      START(N)=A
      FINIS(N)=B
OUT:
      *J_%TOS
! END; ! OF STACK
SCROLL:
                                        ! given a normalised line fragment (START(I),FINIS(I)),
                                        ! picks it up, ITOE and store in buffer
                                        ! I=1 : last line   I=2 : penultimate etc
      X=START(I)
      Y=FINIS(I)
      L=Y-X+1
      %IF X<=Y %THEN MOVE(L,X,ADDR(LINE)+1) %ELSE %START
         L=L+SIZE
         MOVE(A0+SIZE-X,X,ADDR(LINE)+1)
         MOVE(Y+1-A0,A0,ADDR(LINE)+(A0+SIZE-X)+1)
      %FINISH
      LENGTH(LINE)=L
      ITOE(ADDR(LINE)+1,L)
      MOVE(L,ADDR(LINE)+1,B0+BL-41*(I-1))
      *J_%TOS
! END; ! OF SCROLL
START HERE:
      SIZE=A1-A0+1;                     ! size of comms buffer
      ISTART=I;                         ! remember for wrapround
      FREQD=-CURS
      F=0
      LIM=LIM-1
      BL=LIM*41
      N=0;                              ! no. of lines found
      %IF I=A0 %THEN I=A1 %ELSE I=I-1;  ! address of last NL
NEXT LINE:
      %IF I=A0 %THEN I=A1 %ELSE I=I-1;  ! last ch on line
      IL=I
      I0=I;                             ! 1st ch on line
      C=0;                              ! chars on line
LOOP:
      -> FINISHED %IF I=ISTART
      CH=BYTEINTEGER(I);                ! 'PARSE' buffer into line fragments
      %IF CH=10 %OR CH=0 %START;        ! 10=NL, 0=unused buffer
         ! got a line
         %IF C>0 %START
            P=(C-1)//40;                ! no. of line fragments-1
            A=I0+P*40
            B=IL
            *JLK_<STACK>;               ! last or only fragment
            ->FINISHED %IF F>F REQD
            %IF P>0 %START
               %FOR S=P-1,-1,0 %CYCLE
                  A=I0+S*40
                  B=I0+S*40+39
                  *JLK_<STACK>;         ! any remaining fragments
                  ->FINISHED %IF F>F REQD
               %REPEAT
            %FINISH
         %FINISH
         ->FINISHED %IF CH=0
         ->NEXT LINE
      %FINISH
      C=C+1
      I0=I
      %IF I=A0 %THEN I=A1 %ELSE I=I-1
      ->LOOP
FINISHED:
      MOVE(41,ADDR(BLANKLINE(0)),B0); ! clear op buffer
      MOVE(BL,B0,B0+41)
      %RETURN %IF N=0
      %FOR I=N,-1,1 %CYCLE
         *JLK_<SCROLL>
      %REPEAT
%END; ! OF FORMAT
!*
%ROUTINE CLEAR RESIDENT PICTURE(%INTEGER PICTURE ID)
%INTEGER L
%INTEGER A
      A=RESIDENT PICTURE(PICTURE ID)
      L=INTEGER(A)
      MOVE(41,ADDR(BLANK LINE(0)),A+HDR S)
      MOVE(L-41,A+HDR S,A+HDR S+41)
%END; ! OF CLEAR RESIDENT PICTURE
!*
%ROUTINE INIT RESIDENT PICTURES
%INTEGER A,B
%RECORD(PICTURE F)%NAME PIC
      %IF SSERIES=YES %THEN A=COM_DCUA %ELSE A=COM_GPCA
      B=INTEGER(A+43<<2)+2048
      PIC==RECORD(B)
      RESIDENT PICTURE(2)=B
      PIC_LENGTH=24*41
      CLEAR RESIDENT PICTURE(2)
      PIC==RECORD(B+1024)
      RESIDENT PICTURE(3)=B+1024
      PIC_LENGTH=24*41
      CLEAR RESIDENT PICTURE(3)
      B=INTEGER(A+42<<2);               ! addr(process list)
      PROCESS LIST==RECORD(B)
      RESIDENT PICTURE(1)=B
      CLEAR RESIDENT PICTURE(1)
      B=INTEGER(A+41<<2);               ! addr(operlog)
      RESIDENT PICTURE(0)=B
      OPERLOG==RECORD(B)
%END; ! OF INIT RESIDENT PICTURES
!*
%EXTERNALROUTINE OPER(%RECORD(PF)%NAME P)
%SWITCH FOUND(1:COM LIMIT)
%SWITCH ACT(1:19)
%INTEGER A
%INTEGER A0, A1
%INTEGER B0
%INTEGER BASE
%INTEGER CCSTATE
%INTEGER CELL
%INTEGER CH
%INTEGER DACT
%INTEGER DEST
%INTEGER FLAG
%INTEGER I,J
%INTEGER IPI
%INTEGER L
%INTEGER OP
%INTEGER PREFIX
%INTEGER P1
%INTEGER P2
%INTEGER SCREEN NO
%INTEGER SCURSOR
%INTEGER STATE
%INTEGER STREAM NO
%INTEGER TO
%STRING(7)X,Y
%STRING(40)EBCDICTXT, ISOTXT
%OWNSTRING(63)MSG;               ! needs to be 'OWN' to write from it
%RECORD(PF) Q
%RECORD(BILL F)%NAME BILL
%RECORD(BUFFER F)%NAME BUFFER
%RECORD(DEVICE ENTRY F)%NAME DEVICE ENTRY
%RECORD(IP F)%NAME IP
%RECORD(MP F)%NAME MP
%RECORD(PICTURE F)%NAME PICTURE
%RECORD(SCREEN F)%NAME SCREEN
%RECORD(STREAM F)%NAME STREAM
%RECORD(UNIT F)%NAME U 
!*
                                        ! used to 'FIND PLACE' in IPS array
                                        ! and return index.
                                        ! called with STRM=0 to find free
                                        ! place, >0 to locate specific entry
%INTEGERFN FP(%INTEGER STRM)
%RECORD(IP F)%NAME IP
%INTEGER I
      %FOR I=1,1,IPL %CYCLE
         IP==IPS(I)
         %IF STRM=0 %START
            %IF IP_OUTSTRM=0 %THEN %RESULT=I
         %FINISH %ELSE %START
            %IF STRM=IP_INSTRM %OR STRM=IP_OUTSTRM %C
               %THEN %RESULT=I
         %FINISH
      %REPEAT
      REPORT("FP fails to find ".STRINT(STRM))
      %RESULT=0
%END; ! OF FP
!*
%ROUTINE TRANSFER REQUEST(%INTEGERNAME CURSOR)
      SCREEN_CURSOR=CURSOR
      CURSOR=-1
      U_BUFF STATE=BEING FILLED
      IP==IPS(SCREEN_ID)
      STREAM==STREAMS(IP_OUT CELL)
      STREAM_LENGTH=SCREEN_CURSOR+SCREEN_SIZE-1
      Q=0
      Q_P1=IP_OUT STRM
      Q_P2=SCREEN_CURSOR
      Q_SRCE=X'320000'
      Q_DEST=X'37000A';                 ! transfer request
      DO PON(Q)
%END; ! OF TRANSFER REQUEST
!*
%ROUTINE TRANSFER COMPLETE(%INTEGER STRM,P2,P3,P6)
      Q=0
      Q_P1=STRM
      Q_P2=P2;                          ! 1 bit = next page reqd
                                        ! 2 bit = page not eligible for recapture
                                        ! 4 bit = update users cursor
      Q_P3=P3;                          ! no of bytes transferred
      Q_P5=OP!SCREEN NO<<4
      Q_P6=P6;                          ! no of lines<<24!first line displayed
                                        ! or -1 if no longer on display
      Q_SRCE=X'320000'
      Q_DEST=X'37000C';                 ! transfer complete
      DO PON(Q)
%END; ! OF TRANSFER COMPLETE
!*
%ROUTINE TELL PICTURE OWNER
%RECORD(IP F)%NAME IP
%RECORD(STREAM F)%NAME STREAM
%RECORD(PF) Q
      IP==IPS(SCREEN_ID)
      STREAM==STREAMS(IP_OUT CELL)
      Q=0
      Q_SRCE=X'320008'
      Q_P1=STREAM_STREAM NO
      Q_P2=4;                           ! suspending
      Q_DEST=X'370004';                 ! disable
      DO PON(Q)
      Q_P6=-1
      Q_DEST=STREAM_OWNER
      DO PON(Q)
      %IF U_BUFF STATE>>4=SCREEN NO %THEN U_BUFF STATE=EMPTY
%END; ! OF TELL PICTURE OWNER
!*
%ROUTINE UPDATE OPERLOG(%STRING(63)TXT,%INTEGER MODE)
%INTEGER A
      %IF MODE=ISO %START
         ISOTXT<-TXT
         ISOTXT=ISOTXT." " %WHILE LENGTH(ISOTXT)<40
         EBCDICTXT=ISOTXT
         ITOE(ADDR(EBCDICTXT)+1,40)
      %FINISH %ELSE %START
         EBCDICTXT<-TXT
         EBCDICTXT=EBCDICTXT.E" " %WHILE LENGTH(EBCDICTXT)<40
         ISOTXT=EBCDICTXT
         ETOI(ADDR(ISOTXT)+1,40)
      %FINISH
      A=RESIDENT PICTURE(0)
      MOVE(OPERLOG_LENGTH-41,A+HDR S+41,A+HDR S)
      MOVE(40,ADDR(EBCDICTXT)+1,A+HDR S+OPERLOG_LENGTH-41)
      OPERLOG_UPDATED=-1
      LENGTH(ISOTXT)=LENGTH(TXT);       ! remove space pads
      PRINTSTRING("DT: ".DATE." ".TIME." OPERLOG ".ISOTXT."
")
%END; ! OF UPDATE OPERLOG
!*
%ROUTINE CLEAN
      %IF LENGTH(MP_TXT)>23 %THEN LENGTH(MP_TXT)=23
      ISOTXT=MP_TXT
      %IF ISOTXT->ISOTXT.(STRING(ADDR(KYNL(0)))).MSG %THEN I=I
      PREFIX=MP_SRCE>>16
      %IF PREFIX<RESIDENT %THEN PREFIX=0 %ELSE PREFIX=(PREFIX-RESIDENT)&LAST PROC
%END; ! OF CLEAN
!*
%ROUTINE DISPLAY RESIDENT PICTURE(%INTEGER PICTURE ID)
%INTEGER A
      %RETURN %UNLESS 0<=PICTURE ID<=7
      A=RESIDENT PICTURE(PICTURE ID)
      %RETURN %IF A=0
      %IF SCREEN_ID>0 %THEN TELL PICTURE OWNER
      SCREEN_ID=TOP BIT!PICTURE ID
      SCREEN_PICTURE A=A
      PICTURE==RECORD(A)
      SCREEN_LENGTH=PICTURE_LENGTH
      SCREEN_CODE=EBCDIC
      A=0
      %IF PICTURE ID=0 %THEN A=OPERLOG_LENGTH-SCREEN_SIZE
      SCREEN_CURSOR=A
      SCREEN_WRITE PENDING=1
%END; ! OF DISPLAY RESIDENT PICTURE
!*
%ROUTINE FIRE(%INTEGER CHAIN,CONTROL A,SIZE,BUFFER A)
   %IF SSERIES=YES %START
      U_TCB1_RESP=0;                    ! *** protem ? ***
      U_TCB2_RESP=0
      U_TCB3_RESP=0
      U_TCB4_RESP=0
      U_TCB3_STE=REALISE(CONTROL A&X'FFFC0000')!1
      U_TCB3_DATAD=CONTROL A
      U_TCB4_STE=REALISE(BUFFER A&X'FFFC0000')!1
      U_TCB4_LEN=SIZE
      U_TCB4_DATAD=BUFFER A
   %FINISH %ELSE %START
      U_RCB_LBA = CHAIN
      U_ALE0A = CONTROL A
      U_ALE1S = SIZE
      U_ALE1A = BUFFER A
   %FINISH
      Q = 0
      Q_DEST = EXECUTE
      Q_SRCE=EX REPLY!OP<<8
   %IF SSERIES=YES %START
      %IF CHAIN=INPUT %THEN Q_P1=ADDR(U_TCB1) %ELSE Q_P1=ADDR(U_TCB2)
   %FINISH %ELSE Q_P1=ADDR(U_RCB)
      Q_P2 = U_SNO
      %IF SSERIES=NO %THEN Q_P3 = X'11'; ! DO STREAM COMMAND + CLEAR ABNORMAL
      PON(Q)
%END; ! OF FIRE
!*
%ROUTINE DISPLAY PAGE
      FIRE(OUTPUT,ADDR(SCREEN_CNTRL),SCREEN_SIZE,U_BUFFER A)
      SCREEN_WRITE PENDING=0
      U_STATE=WRITE ISSUED
%END; ! OF DISPLAY PAGE
!*
%ROUTINE PROCESS PAGE
%INTEGER RA
                                        ! needs BUFFER and IP to be set up
      %RETURN %IF IP_INSTRM=X'FFFF';    ! lest CC has already freed incell
      STREAM==STREAMS(IP_INCELL)
      RA=X'81000000'+BUFFER_REAL ADDRESS
      A0=RA+STREAM_START
      B0=U_BUFFER A
      SCURSOR=A0+STREAM_CURSOR
      A1=A0+STREAM_LENGTH
      FORMAT(SCURSOR,A0,A1,B0+17*41,4,IP_CURSOR); ! input bit
      STREAM==STREAMS(IP_OUTCELL);      ! output stream
      A0=RA+STREAM_START
      SCURSOR=A0+STREAM_CURSOR
      A1=A0+STREAM_LENGTH
      FORMAT(SCURSOR,A0,A1,B0,16,IP_CURSOR); ! output bit
      MOVE(41,ADDR(MINUSLINE(0)),B0+16*41); ! line to separate input and output
      MSG=STRINT(100-IP_CURSOR)
      ITOE(ADDR(MSG)+2, 2)
      MOVE(2,ADDR(MSG)+2,B0+16*41+38)
%END; ! OF PROCESS PAGE
!*
%ROUTINE QUEUE(%RECORD(PF)%NAME P)
      CELL=NEW PP CELL
      PP CELLS(CELL)_P=P
      PP CELLS(CELL)_LINK=-1
      %IF U_READ Q=-1 %THEN U_READ Q=CELL %ELSE %START
         I=U_READ Q
         %WHILE PP CELLS(I)_LINK>=0 %CYCLE
            I=PP CELLS(I)_LINK
         %REPEAT
         PP CELLS(I)_LINK=CELL
      %FINISH
%END; ! OF QUEUE
!*
RETRY:
                                     ! start of main program
      %IF KMONNING=YES %THEN OPMON<-KMON>>X'32'&1
      MP==P
      DEST=P_DEST
      OP=DEST>>8&7
      DACT=DEST&255
      P1=P_P1
      P2=P_P2
                                        ! filter out OPER 'COMMANDS'
      %IF DACT=12 %START
         MSG=MP_TXT
         ISOTXT=MSG
         P1=P_SRCE
         %FOR I=1,1,COM LIMIT %CYCLE
            -> FOUND(I) %IF MSG->(OP COMMAND(I)).MSG
         %REPEAT
         I=STOI(MSG);                   ! maybe "OPER n ON/OFF"
         %IF MSG="ON" %THEN P2=2 %C
            %ELSE %IF MSG="OFF" %THEN P2=-1 %C
               %ELSE P2=0
         %IF 0<=I<8 %AND CONTEXT(I)#0 %AND P2#0 %AND %C
            ((OPONOFF(I)=ON %AND P2<0) %OR (OPONOFF(I)=OFF %AND P2>0)) %START
            %IF P2<0 %START;            ! reset 'sensitive' fields
               U==RECORD(CONTEXT(I))
               U_CALLER=0
               U_BUFF STATE=EMPTY
               U_STATE=IDLE
               OPONOFF(I)=OFF
            %FINISH %ELSE OPONOFF(I)=ON
            P_DEST=X'A0001';            ! switch tick on/off
            P_P1=X'32000A'!I<<8
            P_P2=P2
            DO PON(P)
            X=" OK"
         %FINISH %ELSE X=" ??"
         REPLY(P1,"OPER ".ISOTXT.X)
         %RETURN
FOUND(1):
         %IF SDIAGS=YES %START
            %IF MULTI OCP=YES %START
               *INCT_CCTSEMA
               *JCC_8,<CCTSEMAGOT1>
               SEMALOOP(CCTSEMA,0)
            CCTSEMAGOT1:
            %FINISH
            J=CCTBPTR
            %FOR I=0,1,127 %CYCLE
               PKMONREC("OPER CCTRACE:",CCTBUFFER(J))
               J=(J+1)&127
            %REPEAT
         %FINISH
         PRINTSTRING("OPER IPS:-")
         DUMPTABLE(-1,ADDR(IPS(1)),24*IPL)
         %IF SDIAGS=YES %AND MULTI OCP=YES %START; *TDEC_CCTSEMA; %FINISH
         %RETURN
      %FINISH
                                        ! filter out PARSE COM entries
      %IF DACT=14 %START
         PARSE COM(MP_SRCE, MP_TXT)
         %RETURN
      %FINISH
                                        ! filter out comms controller commands
      %IF P_SRCE>>16=X'37' %START
         %IF SDIAGS=YES %THEN CC TRACE(P)
         %IF KMONNING = YES %START
            PKMONREC("OPER CCCM",P) %IF OPMON = YES
         %FINISH
         %IF DACT=8 %START;             ! CC replying to 'DISABLE' for a picture
            Q=0
            Q_SRCE=X'320009'
            Q_P1=P1
            Q_DEST=X'370005';           ! disconnect a picture
            DO PON(Q)
            %RETURN
         %FINISH
         %RETURN %IF DACT=9;            ! CC replying to 'DISCONNECT'
      STREAM NO=P1&FFFF
      IPI=-1
      CC STATE=-1
      %IF P1>>16>0 %START
         ! low level
         CC STATE=P2>>24
         %IF CC STATE=CONNECTING %START
            CELL=P_P4
            STREAM==STREAMS(CELL)
            IPI=STREAM_EXTERNAL STREAM NO>>1
            %IF IPI=0 %THEN IPI=FP(0)
            %IF IPI=0 %THEN ->FCCR
            IP==IPS(IPI)
            %IF STREAM NO&1>0 %THEN IP_OUTCELL=CELL %AND IP_OUTSTRM=STREAMNO %C
               %ELSE IP_INCELL=CELL %AND IP_INSTRM=STREAM NO
            IP_STATE=0
            IP_OP=P_P5
            IP_CURSOR=0
         %FINISH
      %FINISH
      %IF IPI<0 %START
         IPI=FP(STREAM NO)
         %IF IPI=0 %THEN ->FCCR
         IP==IPS(IPI)
         %IF STREAM NO&1>0 %THEN CELL=IP_OUTCELL %ELSE CELL=IP_INCELL
         STREAM==STREAMS(CELL)
         %IF CC STATE=ENABLING %AND STREAM NO&1>0 %AND IP_INCELL#0 %START
            ! 4K max IT buffer for NEWSTARTs
            %IF STREAM_START+STREAM_LENGTH>4095 %START
               OPMESS3(" 0/ NEWSTART - IT buffer too large")
               ->RIP
            %FINISH
         %FINISH
      %FINISH
      I=STREAM_DEVICE NO&7
      %IF OPONOFF(I)=OFF %THEN ->RIP;   ! configured off
      U==RECORD(CONTEXT(I))
      SCREEN NO=STREAM_DEVICE NO>>4
       ->RIP %UNLESS 0<=SCREEN NO<=3
      SCREEN==U_SCREEN(SCREEN NO)
       ->RIP %IF SCREEN_SIZE=0
         %IF DACT=6 %THEN ->GO AHEAD
         %IF DACT=7 %THEN ->SEND CONTROL
RIP:                                    ! release IP record
         IP=0
FCCR:                                   ! fail CC request
         P1=P1>>16
         %UNLESS P1=0 %START;           ! Reply to CC if possible
            Q=0
            Q_DEST=X'370000'!P1
            Q_SRCE=DEST
            Q_P1=STREAM NO
            Q_P2=-1
            DO PON(Q)
         %FINISH
         PKMONREC("**OPER CC REQFAIL",P)
         %RETURN
      %FINISH
                                        ! check/perform initialisation
      BASE=CONTEXT(OP)
      %IF BASE=0 %START
         %IF (SSERIES=YES %AND SINIT=0) %OR %C
            (SSERIES=NO %AND INPUT=0) %START
            %IF SSERIES=YES %THEN SINIT=1 %ELSE %START
               INPUT=ADDR(IN LBE(0))
               OUTPUT=ADDR(OUT LBE(1))
            %FINISH
            LAST PROC=COM_MAXPROCS-1
            %IF SSERIES=YES %THEN I=COM_DCUA %ELSE I=COM_GPCA
            INTEGER(I+43<<2)=ADDR(SVPICS(0))-2048
            INIT RESIDENT PICTURES
         %FINISH
            %IF DACT=2 %START
               %IF P1=0 %START
                  DEVICE ENTRY==RECORD(P_P3)
                  BASE=DEVICE ENTRY_BUFF A
                  CONTEXT(OP)=BASE
                  U==RECORD(BASE)
                  U=0
                  U_SNO=P_P2
                  U_READ Q=-1
                  U_BUFF STATE=EMPTY
                  %IF SSERIES=YES %START
                     U_TCB1_COMMAND=X'2F404002'; ! read
                     U_TCB1_STE=REALISE(ADDR(U_INPUT LINE)&X'FFFC0000')!1
                     U_TCB1_LEN=40
                     U_TCB1_DATAD=ADDR(U_INPUT LINE)+86
                     U_TCB1_NTCB=ADDR(U_TCB2)
                     U_TCB2_COMMAND=X'2E404081';       ! init
                     U_TCB2_STE=REALISE(ADDR(INIT DATA)&X'FFFC0000')!1
                     U_TCB2_LEN=4
                     U_TCB2_DATAD=ADDR(INIT DATA)
                     U_TCB2_NTCB=ADDR(U_TCB3)
                     U_TCB3_COMMAND=X'2E404085';       ! write control
                     U_TCB3_LEN=2
                     U_TCB3_NTCB=ADDR(U_TCB4)
                     U_TCB4_COMMAND=X'2E004083';       ! write
                  %FINISH %ELSE %START
                     U_RCB_FLAGS=X'00FF4000'
                     U_RCB_LBS=4*4
                     U_RCB_ALS=3*2*4
                     U_RCB_ALA=ADDR(U_ALE0S)
                     U_ALE0S=2;                        ! rest set up by FIRE
                     U_ALE2S=40
                     U_ALE2A=ADDR(U_INPUT LINE)+86
                  %FINISH
                  U_BUFFER A=CONTEXT(OP)+UREC SPACE
                  %FOR I=0,1,3 %CYCLE
                     SCREEN NO=I
                     SCREEN==U_SCREEN(I)
                     %IF DEVICE ENTRY_SCREEN DESC>>I&1>0 %START
                        ! screen exists
                        %IF I=0 %START
                           SCREEN_SIZE=21*41
                        %FINISH %ELSE %START
                           SCREEN_SIZE=24*41
                        %FINISH
                        SCREEN_HL CURSOR=-1
                        SCREEN_CNTRL=CONTROL WORDS(I)
                        DISPLAY RESIDENT PICTURE(I&1)
                     %FINISH
                  %REPEAT
                  P=0
                  P_DEST=X'A0001';      ! clocktick
                  P_P1=X'32000A'!OP<<8
                  P_P2=2
                  DO PON(P)
                  %IF SSERIES=YES %THEN FIRE(OUTPUT,ADDR(LAST3C),4,ADDR(CLEAR3)) %C
                  %ELSE FIRE(ADDR(OUT LBE(0)),ADDR(LAST3C),4,ADDR(CLEAR3))
                  U_STATE=WRITE ISSUED
               %FINISH
            %FINISH %ELSE %START
               REPORT(STRINT(OP)." not initialised")
            %FINISH
         %RETURN
      %FINISH
      U==RECORD(BASE)
      %IF DACT=5 %START;                ! analyse interrupt response
         %IF OPONOFF(OP)=OFF %START;    ! configured off
            U_STATE=IDLE
            %RETURN
         %FINISH
         FLAG=P1>>20&15
         %IF FLAG&NORMAL#0 %THEN DACT=15 %ELSE %START
            %IF FLAG=ATTENTION %START
               %IF P1&ENTER#0 %THEN DACT=16 %ELSE %C
                  %IF P1&COMMAND#0 %THEN DACT=17 %ELSE %C
                     %IF P1&PGF#0 %START
                        DACT=18
                        P1=1
                        P2=0
                  %FINISH %ELSE %START
                     %IF P1&PGB#0 %START
                        DACT=18
                        P1=-1
                        P2=0
                     %FINISH
                  %FINISH
            %FINISH
         %FINISH
      %FINISH
!*
      %IF KMONNING=YES %START
         PKMONREC("OPER gets:",P) %IF OPMON =YES
      %FINISH
!*
      %IF DACT=5 %START
         REPORT(STRINT(OP)." abnormal termination")
         ->NOW IDLE
      %FINISH
!*
      ->ACT(DACT)
!*
ACT(9):
      %RETURN
!*
ACT(*):
         ->HELP
!*
ACT(1):                               ! provide DIRECT with ex strm no
                                      ! director uses n & n+1 for the input and output streams
      Q=0
      Q_DEST=P_SRCE
      Q_SRCE=DEST
      I=FP(0);                          ! find free record
      %IF I=0 %THEN ->HELP;             !*JM* ->none free
      IP==IPS(I)
      IP=0
      IP_OUTSTRM=1;                     ! in use
      Q_P1=I<<1
      DO PON(Q)
      %RETURN
!*
ACT(3):                               ! execute failure
      REPORT(STRINT(OP)." fire fails P1=".STRINT(P1))
      ->NOW IDLE
!*
ACT(4):                                 ! set OPER facilities bits
      %IF VIDEO UPDATING=YES %START
         OPER FACILITIES=P1
      %FINISH
      %RETURN
!*
ACT(11):
      LENGTH(ISOTXT)=36
      MOVE(36,P_P1,ADDR(ISOTXT)+1)
      RETURN PP CELL(P_P2)
      ->ACT7B
!*
ACT(13):
      PREFIX=P_SRCE>>16
      %IF PREFIX<RESIDENT %THEN PREFIX=0 %ELSE PREFIX=(PREFIX-RESIDENT)&LAST PROC
      LENGTH(ISOTXT)=36
      MOVE(36,P_P1,ADDR(ISOTXT)+1)
      RETURN PP CELL(P_P2)
      ->ACT7A
!*
ACT(7):                                 ! write line to operlog
      CLEAN
ACT7A:
      ISOTXT=STRINT(PREFIX)."/ ".ISOTXT
      %IF PREFIX<10 %THEN ISOTXT=" ".ISOTXT
ACT7B:
      UPDATE OPERLOG(ISOTXT,ISO)
      ->LOOK FOR WORK
!*
ACT(6):                                 ! PON for display text
      BILL==P
      %IF BILL_ZERO=255 %START;         ! clear relevant picture
         %IF BILL_LINE<72 %THEN CLEAR RESIDENT PICTURE(3) %C
            %ELSE CLEAR RESIDENT PICTURE(2)
      %FINISH
      DISPLAY TEXT(0,BILL_LINE,BILL_POS,BILL_TXT)
      ->LOOK FOR WORK
!*
ACT(8):                                 ! request input
      %UNLESS U_CALLER=0 %THEN QUEUE(P) %ELSE %START
         U_CALLER=P_SRCE
         CLEAN
         LENGTH(ISOTXT)=15 %IF LENGTH(ISOTXT)>15
         MSG=ISOTXT." from ".STRINT(PREFIX).STRING(ADDR(SNLS(0)))
         ITOE(ADDR(MSG)+1,LENGTH(MSG))
         U_PROMPT=MSG
         U_READ PENDING=2
      %FINISH
      ->LOOK FOR WORK
!*
ACT(15):                                ! normal termination
      STATE=U_STATE
      %IF STATE=IDLE %START
         REPORT(STRINT(OP)." spurious termination")
         ->HELP
      %FINISH
      ->NOW IDLE %IF STATE=WRITE ISSUED
      ->NOW IDLE %IF STATE=SLOW WRITE ISSUED
      %IF STATE=PROMPT ISSUED %START
         U_INPUT ENABLED=1
         %UNLESS U_INPUT MODE=REQUESTED %THEN -> NOW IDLE
!*       a NEWSTART prompt - I think!!
         SCREEN==U_SCREEN(0)
         %IF SCREEN_ID>0 %THEN TELL PICTURE OWNER %AND SCREEN_ID=0;   !*JM*
         DISPLAY PAGE
         %RETURN
      %FINISH
      %IF STATE=READ ISSUED %START
         U_INPUT ENABLED=0
         L=40
         %IF SSERIES=YES %THEN A=U_TCB1_DATAD-1 %ELSE A=U_ALE2A-1
         %FOR I=1,1,40 %CYCLE
            %IF BYTEINTEGER(A+I)=X'1D' %START; ! EBCDIC NL
               L=I-1
               %EXIT
            %FINISH
         %REPEAT
         BYTEINTEGER(A)=L
         MSG=STRING(A)
         ETOI(A+1,L)
         %IF U_INPUT MODE=COMMANDED %START
            U_INPUT LINE=U_INPUT LINE.STRING(A)
            L=LENGTH(U_INPUT LINE)
            %IF 0<L<80 %AND CHARNO(U_INPUT LINE,L)='&' %START
               CHARNO(U_INPUT LINE,L)=' '
               U_STATE=PROMPT ISSUED
               FIRE(OUTPUT,ADDR(LINE21C),LENGTH(MSG),ADDR(MSG)+1)
               %RETURN
            %FINISH
            PARSE COM(X'320007'!OP<<8,U_INPUT LINE)
         %FINISH %ELSE %START
            %IF U_INPUT MODE=REQUESTED %START
               U_INPUT LINE=STRING(A)."
"
               L=L+1
               %IF KMONNING=YES %START
                  PRINTSTRING("OPER inpt ".U_INPUT LINE) %IF OPMON=YES
               %FINISH
               IP==IPS(U_CALLER)
               STREAM==STREAMS(IP_INCELL); ! input stream
               BUFFER==BUFFERS(STREAM_LINK)
               A0=X'81000000'+BUFFER_REAL ADDRESS+STREAM_START
               A1=A0+STREAM_LENGTH
                                           ! A0 and A1 define limits of circular buffer
               SCURSOR=A0+IP_INP3;      ! where new input has to start
               %FOR I=1,1,L %CYCLE
                  BYTEINTEGER(SCURSOR)=BYTEINTEGER(ADDR(U_INPUT LINE)+I)
                  %IF SCURSOR=A1 %THEN SCURSOR=A0 %ELSE SCURSOR=SCURSOR+1
               %REPEAT
               TRANSFER COMPLETE(IP_INSTRM,4,L,0)
            %FINISH %ELSE %START
               ! as a result of activity 8
               MP_DEST=U_CALLER
               MP_SRCE=X'320007'!OP<<8
               PREFIX=(U_CALLER>>16-RESIDENT)&LAST PROC
               MSG=STRINT(PREFIX)."< ".STRING(A)
               MSG=" ".MSG %IF PREFIX<10
               UPDATE OPERLOG(MSG,ISO)
               MSG=STRING(A)."
"
               %CYCLE
                  MP_TXT<-MSG
                  DO PON(MP)
                  PKMONREC("To caller:",MP)
                  L=LENGTH(MSG)-23
                  %EXIT %UNLESS L>0
                  LENGTH(MSG)=L
                  MOVE(L,ADDR(MSG)+24,ADDR(MSG)+1)
               %REPEAT
            %FINISH
            U_CALLER=0
         %FINISH
      %FINISH
      ->NOW IDLE
!*
ACT(16):                                ! ENTER key
      %IF U_INPUT ENABLED>0 %THEN U_ENTER PENDING = 1
      ->LOOK FOR WORK
!*
ACT(17):                                ! COMMAND key
      %IF U_STATE=PROMPT ISSUED %START
         %UNLESS U_INPUT MODE=COMMANDED %START
            U_COMMAND PENDING=1
            U_READ PENDING=U_INPUT MODE
         %FINISH
      %FINISH %ELSE %START
         %IF U_INPUT ENABLED=0 %START
            U_COMMAND PENDING=1
         %FINISH %ELSE %START
            %UNLESS U_INPUT MODE=COMMANDED %START
               U_COMMAND PENDING=1
               U_READ PENDING=U_INPUT MODE
            %FINISH
         %FINISH
      %FINISH
      ->LOOK FOR WORK
!*
ACT(18):                                ! PGF or PGB
      %RETURN %UNLESS 0<=P2<=3
      SCREEN==U_SCREEN(P2)
      %RETURN %IF SCREEN_SIZE=0
      %IF SCREEN_ID>>28=X'C' %START
         IPI=SCREEN_ID&255
         IP==IPS(IPI)
         %IF IP_STATE&4=0 %START
            IP_STATE=IP_STATE!4;        ! set PGF/PGB bit
            SCURSOR=IP_CURSOR+P1
            %IF SCURSOR>0 %THEN SCURSOR=0
            IP_CURSOR=SCURSOR
         %FINISH
      %FINISH %ELSE %START
         SCURSOR=SCREEN_CURSOR+P1*SCREEN_SIZE
         %IF SCURSOR<0 %THEN SCURSOR=0
         %IF SCURSOR+SCREEN_SIZE>SCREEN_LENGTH %THEN SCURSOR=SCREEN_LENGTH-SCREEN_SIZE
         %UNLESS SCURSOR=SCREEN_CURSOR %START
            %IF SCREEN_ID<0 %THEN SCREEN_WRITE PENDING=1 %C
                  %AND SCREEN_CURSOR=SCURSOR %ELSE %START
               IP==IPS(SCREEN_ID)
               Q=0
               Q_P1=IP_OUTSTRM
               Q_P6=SCURSOR//41
               Q_DEST=STREAMS(IP_OUTCELL)_OWNER
               Q_SRCE=X'320000'
               DO PON(Q)
            %FINISH
         %FINISH
      %FINISH
      ->LOOK FOR WORK
!*
ACT(19):                              ! show picture,screen
      %RETURN %UNLESS 0<=P2<=3
      SCREEN==U_SCREEN(P2)
      %RETURN %IF SCREEN_SIZE=0
      %IF P1<0 %START
         %IF LPSV->X.(STRING(ADDR(P_P3))).Y %THEN P1=LENGTH(X)
      %FINISH
      DISPLAY RESIDENT PICTURE(P1)
      ->LOOK FOR WORK
!*
SEND CONTROL:                           ! message from comms controller
      %IF CC STATE<0 %START
         ! high level
         %IF STREAM_EXTERNAL STREAM NO=0 %START
            ! picture
            %RETURN %IF SCREEN_HL CURSOR>=0; ! previous call still being processed
            I=P_P6*41;                  ! check/make P6 sensible
            %IF I<0 %THEN I=0 %ELSE %C
               %IF I+SCREEN_SIZE>SCREEN_LENGTH %THEN I=SCREEN_LENGTH-SCREEN_SIZE
            SCREEN_HL CURSOR=I
         %FINISH %ELSE %START
            ! interactive process, input or output request
            %IF STREAM NO&1=0 %START
               IP_INP2=P2
               IP_INP3=P_P3
               IP_STATE=IP_STATE!1
            %FINISH %ELSE %START
               STREAM_CURSOR=P2
               Q=0
               Q_SRCE=DEST
               %IF P_SRCE&255=18 %START
                  Q_DEST=STREAM_OWNER
                  Q_P5=P2
               %FINISH %ELSE %START
                  Q_DEST=P_SRCE
                  Q_P1=STREAM NO
                  Q_P2=0
               %FINISH
               DO PON(Q)
               IP_STATE=4 %IF IP_STATE=0;   ! display if idle
            %FINISH
         %FINISH
      %FINISH %ELSE %START
         ! low level
         %IF CC STATE=DISCONNECTING %START
            %IF STREAM NO&1#0 %THEN IP=0 %ELSE IP_INSTRM=X'FFFF'
         %FINISH %ELSE %START
            %IF STREAM_EXTERNAL STREAM NO=0 %START
               ! picture
               %IF CC STATE=CONNECTING %START
                  %IF SCREEN_ID>0 %THEN TELL PICTURE OWNER
                  SCREEN_ID=IPI
               %FINISH %ELSE %START
                  %IF CC STATE=ENABLING %START
                     SCREEN_CODE=STREAM_MODE>>4
                     SCREEN_LENGTH=STREAM_LENGTH+1
                  %FINISH
               %FINISH
            %FINISH
         %FINISH
         Q=0
         Q_P1=STREAM NO
         Q_SRCE=DEST
         Q_DEST=X'370000'!P1>>16;       ! reply
         DO PON(Q)
      %FINISH
      ->LOOK FOR WORK
!*
GO AHEAD:                               ! picture now available
                                        !   P2 = buffer no
      BUFFER==BUFFERS(P2)
      %IF STREAM_EXTERNAL STREAM NO=0 %START
         ! picture
         %IF BUFFER_LENGTH=SCREEN_SIZE %THEN STATE=FULL %ELSE %START
            %IF U_BUFF STATE=BEING FILLED %THEN STATE=FIRST PART %C
               %ELSE STATE=SECOND PART
         %FINISH
         U_BUFF STATE=STATE!SCREEN NO<<4
      %FINISH %ELSE %START
         ! interactive process
         I=IP_STATE
         IP_STATE=I&X'F0F'!((I&X'F0')<<4)
      %FINISH
      ->LOOK FOR WORK
!*
HELP:
      PKMONREC("OPER help",P)
      %RETURN
!*
ACT(10):                                ! mark process list updated
      INTEGER(RESIDENT PICTURE(1)+4)=-1
      ->LOOK FOR WORK
!*
NOW IDLE:
      U_STATE=IDLE
LOOK FOR WORK:
      %IF OPONOFF(OP)=OFF %START;       ! configured off
         %IF OP=0 %START;               ! find pseudo 'MAIN' OPER
            %FOR I=1,1,7 %CYCLE
               %IF OPONOFF(I)=ON %AND CONTEXT(I)#0 %START
                  U==RECORD(CONTEXT(I))
                  ->NEWMAIN
               %FINISH
            %REPEAT
         %FINISH
         %RETURN
NEWMAIN:
      %FINISH
      %UNLESS U_STATE=IDLE %THEN %RETURN
      %IF U_ENTER PENDING>0 %START;   ! deal with 'ENTER'
         U_ENTER PENDING=0
         FIRE(INPUT,ADDR(LAST3C),4,ADDR(CLEAR3))
         U_STATE=READ ISSUED
         %RETURN
      %FINISH
      %IF U_COMMAND PENDING>0 %START; ! deal with 'COMMAND'
         U_COMMAND PENDING=0
         U_STATE=PROMPT ISSUED
         U_INPUT MODE=COMMANDED
         U_INPUT LINE=""
         FIRE(OUTPUT,ADDR(LINE21C),LENGTH(COMMANDP),ADDR(COMMANDP)+1)
         %RETURN
      %FINISH
      %IF U_CALLER=0 %AND U_READQ>=0 %START
         ! no read in progress but one queued
         CELL=U_READ Q
         U_READ Q=PP CELLS(CELL)_LINK
         P=PP CELLS(CELL)_P
         RETURN PP CELL(CELL)
         ->RETRY
      %FINISH
ACT10A:
      %IF U_READ PENDING>0 %AND U_INPUT ENABLED=0 %START
         U_INPUT MODE=U_READ PENDING
         U_READ PENDING=0
         U_STATE=PROMPT ISSUED
         FIRE(OUTPUT,ADDR(LINE21C),LENGTH(U_PROMPT),ADDR(U_PROMPT)+1)
         %IF U_INPUT MODE=REQUESTED %AND U_CALLER#0 %START
            IP==IPS(U_CALLER)
            STREAM==STREAMS(IP_INCELL); ! input stream
            BUFFER==BUFFERS(STREAM_LINK)
            SCREEN==U_SCREEN(0)
            PROCESS PAGE
         %FINISH
         %RETURN
      %FINISH
      %UNLESS U_BUFF STATE=EMPTY %START
         STATE=U_BUFF STATE&15
         %UNLESS STATE>=BEING FILLED %START; ! being filled or still being filled
            SCREEN NO=U_BUFF STATE>>4
            SCREEN==U_SCREEN(SCREEN NO)
            IPI=SCREEN_ID
            IP==IPS(IPI)
            STREAM==STREAMS(IP_OUTCELL)
            BUFFER==BUFFERS(STREAM_LINK)
            I=X'81000000'+BUFFER_REAL ADDRESS+BUFFER_OFFSET
            TO=U_BUFFER A
            %IF STATE=SECOND PART %THEN TO=TO+SCREEN_SIZE-BUFFER_LENGTH
            MOVE(BUFFER_LENGTH,I,TO)
            %IF STATE=FIRST PART %START
               TRANSFER COMPLETE(IP_OUTSTRM,1,BUFFER_LENGTH,0) 
               U_BUFF STATE=U_BUFF STATE&X'F0'+STILL BEING FILLED 
            %FINISH %ELSE %START
               ITOE(U_BUFFER A,SCREEN_SIZE) %IF SCREEN_CODE=ISO
               DISPLAY PAGE
               U_BUFF STATE=EMPTY
               TRANSFER COMPLETE(IP_OUTSTRM,4,0,(SCREEN_SIZE//41)<<24!(SCREEN_CURSOR//41))
            %FINISH
         %FINISH
         %RETURN; ! either displaying or awaiting second part
      %FINISH
      %FOR I=0,1,3 %CYCLE
         SCREEN NO=I
         SCREEN==U_SCREEN(I)
         %UNLESS SCREEN_SIZE=0 %START
            %IF SCREEN_ID>>28=8 %START
               PICTURE==RECORD(SCREEN_PICTURE A)
               A=1<<(OP<<2+I)
               %IF PICTURE_UPDATED&A>0 %OR SCREEN_WRITE PENDING>0 %START
                  PICTURE_UPDATED=PICTURE_UPDATED&(\A)
                  MOVE(SCREEN_SIZE,SCREEN_PICTURE A+SCREEN_CURSOR+HDR S,U_BUFFER A)
                  DISPLAY PAGE
                  U_STATE=SLOW WRITE ISSUED
                  %RETURN
               %FINISH
            %FINISH %ELSE %START
               %IF SCREEN_ID>0 %START
                  %IF SCREEN_HL CURSOR>=0 %START
                     TRANSFER REQUEST(SCREEN_HL CURSOR)
                     %RETURN
                  %FINISH
               %FINISH
            %FINISH
         %FINISH
      %REPEAT
      %FOR IPI=1,1,IPL %CYCLE
         IP==IPS(IPI)
         U==RECORD(CONTEXT(IP_OP&7))
         SCREEN==U_SCREEN(IP_OP>>4)
         STATE=IP_STATE
         %IF STATE&X'F0'=0 %AND STATE#0 %START
            ! no transfer in progress
            %IF STATE&X'F00'>0 %START
               ! some transfer completed
               %IF STATE&X'100'>0 %START
                  ! an input transfer
                  %IF U_CALLER=0 %START
                     %IF SCREEN_ID>0 %THEN TELL PICTURE OWNER
                     SCREEN_ID=X'C0000000'+IPI
                     U_CALLER=IPI
                     BUFFER==BUFFERS(STREAMS(IP_INCELL)_LINK)
                     STREAM==STREAMS(IP_OUTCELL); ! output stream
                     A0=X'81000000'+BUFFER_REALADDRESS+STREAM_START
                     A1=A0+STREAM_LENGTH
                     SCURSOR=A0+STREAM_CURSOR; ! first CH of prompt message
                     L=A0+IP_INP2;             ! last CH+1
                     I=1
                     %CYCLE
                        %EXIT %IF SCURSOR=L
                        CH=BYTEINTEGER(SCURSOR)
                        %UNLESS CH=10 %THEN BYTEINTEGER(ADDR(MSG)+I)=CH %C
                              %AND I=I+1
                        %IF SCURSOR=A1 %THEN SCURSOR=A0 %C
                           %ELSE SCURSOR=SCURSOR+1
                        %EXIT %IF I>20
                     %REPEAT
                     LENGTH(MSG)=I-1
                     U_PROMPT=MSG." from ". %C
                        STRINT((STREAM_OWNER>>16-RESIDENT)&LASTPROC). %C
                        STRING(ADDR(SNLS(0)))
                     %IF KMONNING=YES %START
                        PRINTSTRING("OPER PRMT ".U_PROMPT)  %IF OPMON=YES
                     %FINISH
                     ITOE(ADDR(U_PROMPT)+1,LENGTH(U_PROMPT))
                     U_READ PENDING=1
                     IP_STATE=STATE&X'EF3'; ! clear input transfer complete
                     ->ACT10A %IF U_STATE=IDLE
                  %FINISH
               %FINISH %ELSE %START
                  ! PGF/B transfer complete
                  %IF U_STATE=IDLE %START
                  STREAM==STREAMS(IP_OUTCELL)
                     %IF SCREEN_ID=X'C0000000'+IPI %C
                         %AND STREAM_MODE&X'30'#X'30' %START
                                        ! on display & not control mode
                        BUFFER==BUFFERS(STREAM_LINK)
                        PROCESS PAGE
                        DISPLAY PAGE
                     %FINISH
                     %IF STATE&X'400'>0 %START
                        ! PG/B complete
                        TRANSFER COMPLETE(IP_OUTSTRM,0,0,0)
                        IP_STATE=STATE&X'3F3'
                     %FINISH
                  %FINISH
               %FINISH
            %FINISH %ELSE %START
               %IF STATE&X'F'>0 %START
                  ! transfer requested
                  %IF STATE&1>0 %START
                     STATE=STATE&X'FF0'!X'10'
                     STREAM NO=IP_INSTRM
                  %FINISH %ELSE %START
                     STATE=STATE&X'FF0'!X'40'
                     STREAM NO=IP_OUTSTRM
                  %FINISH
                  IP_STATE=STATE
                  Q=0
                  Q_P1=STREAM NO
                  Q_SRCE=X'320000'
                  Q_DEST=X'37000A'; ! transfer request
                  DO PON(Q)
               %FINISH
            %FINISH
         %FINISH
      %REPEAT
!*
      %RETURN
!*
%END; ! OF OPER
!*
%EXTERNALROUTINE DISPLAY TEXT(%INTEGER WHICH,I,J,%STRING(41)TXT)
%INTEGER OP,U,R
%RECORD(PF) P
      %RETURN %UNLESS 0<=J<=39
      %RETURN %UNLESS LENGTH(TXT)>0
      %IF LENGTH(TXT)>40-J %THEN LENGTH(TXT)=40-J
      ITOE(ADDR(TXT)+1,LENGTH(TXT))
      R=1
      ->SKIP LINE CHECK %IF WHICH<0
      %RETURN %UNLESS 0<=I<=95
      %IF I>47 %START
         I=I-48
         %IF I<24 %THEN R=3 %ELSE R=2 %AND I=I-24
      %FINISH
SKIP LINE CHECK:
      MOVE(LENGTH(TXT),ADDR(TXT)+1,RESIDENT PICTURE(R)+HDR S+41*I+J)
      %IF VIDEO UPDATING=YES %START
         %IF OPER FACILITIES&1>0 %START
            %IF R=1 %START; ! keep process list display up to date
               U=PROCESS LIST_UPDATED
               P=0
               %FOR OP=0,1,7 %CYCLE
                  %UNLESS U&15=15 %THEN P_DEST=X'32000A'!OP<<8 %C
                        %AND DO PON(P)
                  U=U>>4
               %REPEAT
            %FINISH
            PROCESS LIST_UPDATED=-1
         %FINISH
      %FINISH
      %UNLESS R=1 %THEN INTEGER(RESIDENT PICTURE(R)+4)=-1; ! mark relevant picture 'UPDATED'
%END; ! OF DISPLAY TEXT
!*
%EXTERNALROUTINE OPMESS3(%STRING(63)TXT)
%STRING(36)T
%RECORD(PF) Q
%INTEGER CELL, CELL A
      Q=0
      Q_DEST=X'32000B'
      T<-TXT
      T=T." " %WHILE LENGTH(T)<36
      CELL=NEW PP CELL
      CELL A=ADDR(PP CELLS(CELL))
      MOVE(36,ADDR(T)+1,CELL A)
      Q_P1=CELL A
      Q_P2=CELL
      DO PON(Q)
%END; ! OF OPMESS3
!*
%ENDOFFILE