!*
!* 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:"
OWNSTRING (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
IF U_CALLER=0 START ; ! lest process has gone with n/ST or whatever
REPORT(STRINT(OP)." no caller for input request")
->NOW IDLE
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