!* !* 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