! %CONSTSTRING(15)VSN = "OPER33 08/09/80"; ! ****************************************
%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
!
!
!
!%EXTERNALROUTINESPEC DUMPTABLE(%INTEGER X,A,S)
%EXTERNALROUTINESPEC PON(%RECORDNAME P)
%EXTERNALROUTINESPEC PKMONREC(%STRING(20)TXT,%RECORDNAME P)
%EXTERNALROUTINESPEC PARSE COM(%INTEGER SRCE,%STRINGNAME S)
%EXTERNALROUTINESPEC RETURN PP CELL(%INTEGER CELL)
!%EXTERNALSTRINGFNSPEC HTOS(%INTEGER N,L)
%EXTERNALSTRINGFNSPEC STRINT(%INTEGER I)
%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)
!
!
!
%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)
!
%OWNRECORDARRAYFORMAT BUFFERS F(0:4095)(BUFFER F)
!
%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 MP F(%INTEGER DEST,SRCE,%STRING(23)TXT)
!
%RECORDFORMAT PF(%INTEGER DEST,SRCE,P1,P2,P3,P4,P5,P6)
!
%RECORDFORMAT PICTURE F(%INTEGER LENGTH,UPDATED, %C
DATA)
!
%RECORDFORMAT PP CELL F(%RECORD P(PF),%INTEGER LINK)
!
%OWNRECORDARRAYFORMAT PP CELLS F(0:4095)(PP CELL F)
!
!
%RECORDFORMAT RCB F(%INTEGER FLAGS,LSTBA,LBS,LBA, %C
ALS,ALA,X1,X2)
!
%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)
!
%OWNRECORDARRAYFORMAT STREAMS F(0:4095)(STREAM F)
!
!
! SIZE OF UNIT RECORD
! RCB 32
! ALES 36
! BYTES 8
! PROMPT 36
! INPUT LINE 128
! SCREENS 144
! BUFFER 984
! ------- ----
! TOTAL 1368
!
!
!
%RECORDFORMAT UNIT F(%RECORD RCB(RCB F), %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
%RECORDARRAY SCREEN(0:3)(SCREEN F))
!
!
!
%OWNRECORDARRAYNAME BUFFERS(BUFFER F)
%OWNRECORDARRAYNAME PP CELLS(PP CELL F)
%OWNRECORDARRAYNAME STREAMS(STREAM F)
!
!
!
%OWNRECORDNAME OPERLOG(PICTURE F)
%OWNRECORDNAME PROCESS LIST(PICTURE F)
!
!
!
%CONSTINTEGER IPL = 16
%OWNRECORDARRAY IPS(1:IPL)(IP F)
%OWNINTEGERARRAY RESIDENT PICTURE(0:7)
! 0 OPERLOG
! 1 PROCESS LIST
! 2 SPOOLR
! 3 VOLUMS
!
%OWNINTEGERARRAY CONTEXT(0:7)
!
!
!
%OWNINTEGER INPUT
%OWNINTEGER OUTPUT
%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 FFFF = X'FFFF'
%CONSTINTEGER FIRST PART = 1
%CONSTINTEGER FULL = 3
%CONSTINTEGER HDR S = 8
%CONSTINTEGER IDLE = 0
%CONSTINTEGER ISO = 0
%CONSTINTEGER LAST PROC = 127
%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
!
%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
!
%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
%CONSTSTRING(8)COMMANDP = E"COMMAND:"
%CONSTSTRING(4)LPSV = "LPSV"
%CONSTSTRINGNAME TIME = X'80C0004B', DATE = X'80C0003F'
!
!
!
!
!-----------------------------------------------------------------------
!
!
%ROUTINE DO PON(%RECORDNAME P)
%RECORDSPEC P(P F)
PON(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 Q(P F)
Q = 0
Q_DEST = DEST
LENGTH(TXT) = 23 %IF LENGTH(TXT) > 23
STRING(ADDR(Q_P1)) = TXT
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 %C
%THEN MOVE(L, X, ADDR(LINE)+1) %C
%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 I SO CAN TEST 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; ! NOW ADDR OF LAST NL
NEXT LINE:
%IF I = A0 %THEN I = A1 %ELSE I = I - 1; ! LAST CH ON LINE
IL = I
I0 = I; ! FIRST CH ON LINE
C = 0; ! COUNT CHS ON LINE
LOOP:
-> FINISHED %IF I = ISTART
!
CH = BYTEINTEGER(I); ! 'PARSE' COMMS 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; ! NUMBER 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
%CYCLE S = P-1, -1, 0
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
!
%CYCLE I = N, -1, 1
*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
%RECORDNAME PIC(PICTURE F)
A = INTEGER(X'80C0001C'); ! ADDR OF TABLE
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 OF PROCESS LIST
PROCESS LIST == RECORD(B)
RESIDENT PICTURE(1) = B
CLEAR RESIDENT PICTURE(1)
!
B = INTEGER(A + 41<<2); ! ADDR OF OPERLOG
RESIDENT PICTURE(0) = B
OPERLOG == RECORD(B)
%END; ! OF INIT RESIDENT PICTURES
!
!-----------------------------------------------------------------------
!
!
%EXTERNALROUTINE OPER(%RECORDNAME P)
%RECORDSPEC P(P F)
%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
%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 Q(P F)
!
!
!
%RECORDNAME BILL(BILL F)
%RECORDNAME BUFFER(BUFFER F)
%RECORDNAME DEVICE ENTRY(DEVICE ENTRY F)
%RECORDNAME IP(IP F)
%RECORDNAME MP(MP F)
%RECORDNAME PICTURE(PICTURE F)
%RECORDNAME SCREEN(SCREEN F)
%RECORDNAME STREAM(STREAM F)
%RECORDNAME U (UNIT F)
!
!
!
!
!
! 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)
%INTEGER I
!* REPORT("FP ".STRINT(STRM))
!* DUMPTABLE(7,ADDR(IPS(1)),96)
%CYCLE I = 1, 1, IPL
IP == IPS(I)
%IF STRM = 0 %START
%IF IP_OUTSTRM = 0 %THEN %RESULT = I
%FINISH %ELSE %START
%IF STRM = IP_INSTRM %C
%OR %C
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
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, %C
A + HDR S + 41,A + HDR S)
MOVE(40,ADDR(EBCDICTXT)+1, %C
A + HDR S + OPERLOG_LENGTH - 41)
OPERLOG_UPDATED = -1
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 %C
%THEN I = I
PREFIX = MP_SRCE >> 16
%IF PREFIX < RESIDENT %C
%THEN PREFIX = 0 %C
%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 %C
%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)
U_RCB_LBA = CHAIN
U_ALE0A = CONTROL A
U_ALE1S = SIZE
U_ALE1A = BUFFER A
Q = 0
Q_DEST = EXECUTE
Q_SRCE = X'320003' ! OP<<8
Q_P1 = ADDR(U_RCB)
Q_P2 = U_SNO
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
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(%RECORDNAME P)
%RECORDSPEC P(P F)
CELL = NEW PP CELL
PP CELLS(CELL)_P = P
PP CELLS(CELL)_LINK = -1
!
%IF U_READ Q = -1 %C
%THEN U_READ Q = CELL %C
%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 %START
OPMON <- (KMON >> X'32') & 1
%FINISH
!
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
TRIM: -> TRIM %IF MSG -> (" ").MSG
P1 = P_SRCE
%CYCLE I = 1, 1, COM LIMIT
-> FOUND(I) %IF MSG -> (OP COMMAND(I)).MSG
%REPEAT
REPLY(P1, "OPER ".MSG." ??")
%RETURN
!
FOUND(1):
%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 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
!
%IF DACT = 9 %THEN %RETURN; ! CC REPLYING TO 'DISCONNECT' FOR A PICTURE
!
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 %C
%THEN IPI = FP(0)
!
IP == IPS(IPI)
%IF STREAM NO & 1 > 0 %C
%THEN IP_OUTCELL = CELL %AND IP_OUTSTRM = STREAM NO %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)
!* REPORT("MAP ".STRINT(IPI))
IP == IPS(IPI)
!
%IF STREAM NO & 1 > 0 %C
%THEN CELL = IP_OUTCELL %C
%ELSE CELL = IP_INCELL
!
STREAM == STREAMS(CELL)
%FINISH
!
U == RECORD(CONTEXT(STREAM_DEVICE NO & 7))
SCREEN NO = STREAM_DEVICE NO >> 4
SCREEN == U_SCREEN(SCREEN NO)
!
!
%IF DACT = 6 %THEN -> GO AHEAD
%IF DACT = 7 %THEN -> SEND CONTROL
!
!
REPORT("FUNNY CC COMMAND")
-> HELP
%FINISH
!
!
!
! CHECK/PERFORM INITIALISATION
BASE = CONTEXT(OP)
%IF BASE = 0 %START
%IF DACT = 2 %START
%IF P1 = 0 %START
DEVICE ENTRY == RECORD(P_P3)
BASE = DEVICE ENTRY_BUFF A
CONTEXT(OP) = BASE
U == RECORD(BASE)
!
%IF INPUT = 0 %START
! INITIALISE OWN VARIABLES
INPUT = ADDR(IN LBE(0))
OUTPUT = ADDR(OUT LBE(1))
!
I = INTEGER(X'80C0001C'); ! ADDR OF TABLE
INTEGER(I + 43 << 2) = ADDR(SVPICS(0)) - 2048
INIT RESIDENT PICTURES
!
BASE = INTEGER(ADDR(PARM DES) + 4)
PP CELLS == ARRAY(BASE,PP CELLS F)
BUFFERS == ARRAY(BASE,BUFFERS F)
STREAMS == ARRAY(BASE,STREAMS F)
!
%FINISH
U = 0
U_SNO = P_P2
!
U_READ Q = -1
U_BUFF STATE = EMPTY
!
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; ! OTHER ALE FIELDS SET UP BY FIRE
U_ALE2S = 40
!
U_BUFFER A = CONTEXT(OP) + 384
U_ALE2A = ADDR(U_INPUT LINE) + 86
!
%CYCLE I = 0, 1, 3
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'
P_P1 = X'32000A' ! OP<<8
P_P2 = 2
PON(P)
!
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; ! INTERRUPT RESPONSE, DETERMINE TYPE
FLAG = P1 >> 20 & 15
%IF FLAG & NORMAL > 0 %START
DACT = 15
%FINISH %ELSE %START
%IF FLAG = ATTENTION %START
%IF P1 & ENTER > 0 %THEN DACT = 16
%IF P1 & COMMAND > 0 %THEN DACT = 17
%IF P1 & PGF > 0 %THEN DACT = 18 %AND P1= 1 %AND P2=0
%IF P1 & PGB > 0 %THEN DACT = 18 %AND P1=-1 %AND P2=0
%FINISH
%FINISH
%FINISH
%IF DACT = 5 %START
REPORT(STRINT(OP)." ABNORMAL TERMINATION")
-> NOW IDLE
%FINISH
!
-> HELP %UNLESS 1 <= DACT <= 19
!
%IF KMONNING = YES %START
PKMONREC("OPER GETS",P) %IF OPMON = YES
%FINISH
!
-> ACT(DACT)
!
!
!
ACT(9):
! INTEGER(RESIDENT PICTURE(1) + 4) = -1; ! MARK PROCESS LIST 'UPDATED'
%RETURN
ACT(2):
-> 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); ! LOCATE A FREE RECORD
IP = 0; ! JUST IN CASE ANY JUNK LEFT IN
IP_OUTSTRM = 1; ! MARK IT IN USE
Q_P1 = I << 1
!
PON(Q)
%RETURN
!
!
!
ACT(3): ! EXECUTE FAILURE
REPORT(STRINT(OP)." FIRE FAILS P1=".STRINT(P1))
-> NOW IDLE
!
!
!
ACT(4):
! SET UP 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 %C
%THEN PREFIX = 0 %C
%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 %C
%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 %C
%THEN QUEUE(P) %C
%ELSE %START
!
U_CALLER = P_SRCE
CLEAN
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
SCREEN == U_SCREEN(0)
DISPLAY PAGE
%RETURN
%FINISH
!
%IF STATE = READ ISSUED %START
U_INPUT ENABLED = 0
L = 40
A = U_ALE2A - 1
%CYCLE I = 1, 1, 40
%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 %C
%AND %C
CHARNO(U_INPUT LINE,L) = '&' %C
%START
CHARNO(U_INPUT LINE,L) = ' '
U_STATE = PROMPT ISSUED
FIRE(OUTPUT,ADDR(LINE21C),LENGTH(MSG),ADDR(MSG)+1)
%RETURN
%FINISH
!* U_INPUT LINE = U_INPUT LINE." "
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
!
%CYCLE I = 1, 1, L
BYTEINTEGER(SCURSOR) = %C
BYTEINTEGER(ADDR(U_INPUT LINE)+I)
%IF SCURSOR = A1 %C
%THEN SCURSOR = A0 %C
%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
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 %C
%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/B REQUEST 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 %C
%THEN SCURSOR = 0
!
%IF SCURSOR + SCREEN_SIZE > SCREEN_LENGTH %C
%THEN SCURSOR = SCREEN_LENGTH - SCREEN_SIZE
!
%UNLESS SCURSOR = SCREEN_CURSOR %START
%IF SCREEN_ID < 0 %C
%THEN SCREEN_WRITE PENDING = 1 %C
%AND %C
SCREEN_CURSOR = SCURSOR %C
%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 %C
%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 %C
%ELSE %START
%IF I + SCREEN_SIZE > SCREEN_LENGTH %C
%THEN I = SCREEN_LENGTH - SCREEN_SIZE
%FINISH
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
%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 %C
%THEN IP = 0 %C
%ELSE IP_STATE = X'1000'
%FINISH %ELSE %START
%IF STREAM_EXTERNAL STREAM NO = 0 %START
! PICTURE
%IF CC STATE = CONNECTING %START
%IF SCREEN_ID > 0 %C
%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 = P_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 %C
%THEN STATE = FULL %C
%ELSE %START
%IF U_BUFF STATE = BEING FILLED %C
%THEN STATE = FIRST PART %C
%ELSE STATE = SECOND PART
%FINISH
U_BUFF STATE = STATE ! SCREEN NO << 4
%FINISH %ELSE %START
! INTERACTIVE PROCESS
!* DUMPTABLE(1,ADDR(STREAM),36)
!* DUMPTABLE(2,ADDR(BUFFER),36)
!* DUMPTABLE(3,X'81000000'+BUFFER_REAL ADDRESS,4096)
I = IP_STATE
IP_STATE = I & X'F0F' ! ((I & X'F0') << 4)
%FINISH
-> LOOK FOR WORK
!
!
!
HELP:
PKMONREC("OPER HELP",P)
%RETURN
!
!
!
!
!
!
ACT(10):
INTEGER(RESIDENT PICTURE(1) + 4) = -1; ! MARK PROCESS LIST 'UPDATED'
-> LOOK FOR WORK
!
!
!
NOW IDLE:
U_STATE = IDLE
LOOK FOR WORK:
%UNLESS U_STATE = IDLE %THEN %RETURN
!
%IF U_ENTER PENDING > 0 %START; ! DEAL WITH 'ENTER'
!* REPORT("FIRE INPUT")
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'
!* REPORT("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 %C
%AND %C
U_READ Q >= 0 %C
%START
! NO READ IN PROGRESS BUT ONE QUEUED
!* REPORT("READ UNQUEUED")
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 %C
%AND %C
U_INPUT ENABLED = 0 %C
%START
!* REPORT("PROMPT:")
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 %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 %C
%THEN TO = TO + SCREEN_SIZE - BUFFER_LENGTH
!
MOVE(BUFFER_LENGTH, I, TO)
!
%IF STATE = FIRST PART %C
%THEN TRANSFER COMPLETE(IP_OUTSTRM,1,BUFFER_LENGTH,0) %C
%AND %C
U_BUFF STATE = U_BUFF STATE&X'F0'+STILL BEING FILLED %C
%ELSE %START
ITOE(U_BUFFER A,SCREEN_SIZE) %IF SCREEN_CODE = ISO
DISPLAY PAGE
U_BUFF STATE = EMPTY
TRANSFER COMPLETE(IP_OUTSTRM,4,0, %C
(SCREEN_SIZE//41)<<24 ! (SCREEN_CURSOR//41))
%FINISH
!
%FINISH
%RETURN; ! EITHER DISPLAYING OR AWAITING SECOND PART
%FINISH
!
%CYCLE I = 0, 1, 3
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 %C
%OR %C
SCREEN_WRITE PENDING > 0 %C
%START
PICTURE_UPDATED = PICTURE_UPDATED & (\A)
MOVE(SCREEN_SIZE, %C
SCREEN_PICTURE A+SCREEN_CURSOR+HDR S, %C
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
!
!
!
%CYCLE IPI = 1, 1, IPL
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
!* REPORT("IPI".STRINT(IPI)." STATE ".HTOS(STATE,3))
%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 %C
%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_REAL ADDRESS + %C
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 %C
%THEN BYTEINTEGER(ADDR(MSG)+I)=CH %C
%AND %C
I = I + 1
!
%IF SCURSOR = A1 %C
%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
%IF OPMON = YES %C
%THEN PRINTSTRING("OPER PRMT ".U_PROMPT)
%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 %START
! ON DISPLAY
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 P(P F)
%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 %C
%THEN R = 3 %C
%ELSE R = 2 %AND I = I-24
%FINISH
!
SKIP LINE CHECK:
MOVE(LENGTH(TXT), ADDR(TXT)+1, %C
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
%CYCLE OP = 0, 1, 7
%UNLESS U&15 = 15 %C
%THEN P_DEST = X'32000A' ! OP<<8 %C
%AND %C
PON(P)
U = U >> 4
%REPEAT
%FINISH
PROCESS LIST_UPDATED = -1
%FINISH
%FINISH
!
%UNLESS R = 1 %C
%THEN INTEGER(RESIDENT PICTURE(R)+4) = -1; ! MARK RELEVANT PICTURE 'UPDATED'
%END; ! OF DISPLAY TEXT
!
!-----------------------------------------------------------------------
!
!
%EXTERNALROUTINE OPMESS2(%INTEGER OP, %STRING(63)TXT)
%STRING(36)T
%RECORD Q(P F)
%INTEGER CELL, CELL A
!
T <- TXT
!
Q = 0
Q_DEST = X'320007'
%IF LENGTH(T) < 24 %START
T = T." " %WHILE LENGTH(T) < 24
MOVE(24, ADDR(T), ADDR(Q_P1))
%FINISH %ELSE %START
Q_DEST = X'32000D'
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
%FINISH
!
PON(Q)
%END; ! OF OPMESS2
!
!-----------------------------------------------------------------------
!
!
%EXTERNALROUTINE OPMESS3(%STRING(63)TXT)
%STRING(36)T
%RECORD Q(P F)
%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
PON(Q)
%END; ! OF OPMESS3
!
!-----------------------------------------------------------------------
%ENDOFFILE