!***********************************************************************
!*
!*               OPER handler for an interactive terminal
!*
!*      Copyright (C) R.D. Eager   University of Kent   MCMLXXXV
!*
!***********************************************************************
!
!
!***********************************************************************
!*
!*          Record and array formats
!*
!***********************************************************************
!
recordformat  comf(integer  ocptype,ipldev,sblks,sepgs,ndiscs,
         dlvnaddr,gpctabsize,gpca,sfctabsize,sfca,sfck,dirsite,
         dcodeda,suplvn,tojday,date0,date1,date2,
         time0,time1,time2,epagesize,users,cattad,servaad,
         byteinteger  nsacs,resv1,sacport1,sacport0,
         nocps,resv2,ocpport1,ocpport0,
         integer  itint,contypea,gpcconfa,fpcconfa,sfcconfa,
         blkaddr,ration,smacs,trans,longinteger  kmon,
         integer  ditaddr,smacpos,supvsn,pstva,secsfrmn,secstocd,
         sync1dest,sync2dest,asyncdest,maxprocs,inspersec,elaphead,
         commsreca,storeaad,procaad,sfcctad,drumtad,tslice,feps,
         maxcbt,performad,sp1,sp2,sp3,sp4,sp5,sp6,
         lstl,lstb,pstl,pstb,hkeys,hoot,sim,clkx,clky,clkz,
         hbit,slaveoff,inhssr,sdr1,sdr2,sdr3,
         sdr4,sesr,hoffbit,blockzbit,blkshift,blksize,end)
recordformat  iostatf(integer  inpos,string (15) intmess)
recordformat  itf(integer  inbase,inlength,inpointer,outbase,
                  outlength,outpointer,outbusy,omwaiting,inttwaiting,
                  jnbase,jncur,jnmax,lastfree,spare5,spare6,spare7)
recordformat  lpicf(string (6) owner,string (11) file,
                    byteinteger  fsys,integer  hisno, addr,screens,srce)
recordformat  pe(integer  dest,srce,
                 (integer  p1,p2,p3,p4,p5,p6 or  c 
                 string (23) message or  c 
                 integer  picno,fsys,screen,string (11) file))
recordformat  rf(integer  conad,filetype,datastart,dataend)
recordformat  scf(byteintegerarray  header(1:8),text(1:40))
!
ownintegerarrayformat  tablef(0:43)
ownrecord (scf)arrayformat  scaf(1:24)
!
!
!***********************************************************************
!*
!*          Constants
!*
!***********************************************************************
!
constantinteger  no = 0, yes = 1
constantinteger  stopped = 0, running = 1
                                        ! Clock states
constantinteger  sysprocs = 5;          ! Number of permanent 'system' processes
constantbyteinteger  null = x'00'
constantbyteinteger  cr = x'0d'
constantbyteinteger  flash = x'11'
constantbyteinteger  eom = x'19'
!
constantinteger  default refresh interval = 5
                                        ! Seconds
constantinteger  default seconds per tick = 3
!
constantinteger  elapsed int service = x'000a0000'
constantinteger  single kick act = 2
!
constantinteger  oper service = x'00320000'
constantinteger  update log act = 7
constantinteger  parse com act = 14
!
constantlonginteger  int mask = x'0382000a0382000a'
                                        ! INT: A,C,Q,W,X,Y,a,c,q,w,x,y
constantrecord (comf)name  com = x'80c00000'
                                        ! Supervisor communication segment
constantinteger  first local picture = 4
constantinteger  last local picture = 5
!
constantinteger  maxlcom = 5;           ! Number of local commands
constantstring (2)array  lcom(1:maxlcom) = "R","MF","M","U","ST"
!
constantstring (1) snl = "
"
constantstring (4) lpsv = "LPSV"
!
constantbyteintegerarray  screen size(0:1) = 21,24
constantbyteintegerarray  initial page(0:last local picture) = c 
2,0,0,0,0(last local picture-first local picture+1)
!
!
!***********************************************************************
!*
!*          Owns
!*
!***********************************************************************
!
owninteger  clock status
owninteger  message status
owninteger  my sync1 dest
owninteger  prompt service
owninteger  refresh interval
owninteger  seconds per tick
owninteger  operlog altered
ownstring (31) command erase screen
ownstring (31) command erase line
ownstring (31) command move to prompt
ownstring (31) command move to input line
ownstring (31) command move to bottom line
ownstring (40) promptstring
ownrecord (pe) clockp
ownrecord (iostatf)name  iostat
ownrecord (itf)name  it
ownintegerarray  current picture(0:1)
ownintegerarray  current page(0:1)
ownintegerarray  resident picture(0:3)
ownstring (255) oldmode
ownrecord (scf)array  buffs(1:24,0:1)
ownrecord (lpicf)array  local picture(first local picture:last local picture)
!
!
!***********************************************************************
!*
!*          Director references
!*
!***********************************************************************
!
externalintegerfunctionspec  dloweracr(integer  newacr)
externalroutinespec  dpoff(record (pe)name  p)
externalroutinespec  dpon(record (pe)name  p)
externalroutinespec  dtoff(record (pe)name  p)
!
!
!***********************************************************************
!*
!*          Subsystem references
!*
!***********************************************************************
!
systemroutinespec  connect(string (31) file,integer  mode,hole,
                           prot,record (rf)name  r,integername  flag)
systemroutinespec  console(integer  ep,integername  start,len)
systemroutinespec  etoi(integer  ad,l)
systemstringfunctionspec  failuremessage(integer  mess)
systemstringfunctionspec  itos(integer  n)
externalstringfunctionspec  modestr
systemroutinespec  move(integer  length,from,to)
systemintegerfunctionspec  parmap
externalroutinespec  prompt(string (255) s)
systemintegerfunctionspec  pstoi(string (63) s)
systemroutinespec  reroutecontingency(integer  ep,class,
                                      longinteger  mask,
                                      routine  ontrap,
                                      integername  flag)
systemroutinespec  sdisconnect(string (31) file,integer  fsys,
                               integername  flag)
systemroutinespec  setfname(string (63) s)
externalroutinespec  setmode(string (255) s)
systemroutinespec  setpar(string (255) s)
externalroutinespec  set return code(integer  i)
systemroutinespec  signal(integer  ep,p1,p2,integername  flag)
systemstringfunctionspec  spar(integer  n)
systemroutinespec  uctranslate(integer  ad,len)
externalintegerfunctionspec  uinfi(integer  entry)
externalstringfunctionspec  vduc(integer  x,y)
externalstringfunctionspec  vdus(integer  n)
!
externalroutinespec  messages(string (255) s)
!
!
!***********************************************************************
!*
!*          Other external references
!*
!***********************************************************************
!
systemroutinespec  mon(string (255) s)
!
!
!***********************************************************************
!*
!*          Service routines
!*
!***********************************************************************
!
routine  clear screen
! Clear the screen in a terminal-independent manner.
integer  ad,len
!
ad = addr(command erase screen) + 1
len = length(command erase screen)
console(10,ad,len)
end ;   ! of clear screen
!
!-----------------------------------------------------------------------
!
routine  clear pending prompts
! Send  a  plausible  reply  to any system process awaiting a reply to a
! prompt, so that it does not lock up if the program is left without the
! user typing a reply.
integer  procno
string (15) s
record (pe) p
!
return  if  prompt service = 0;         ! No pending prompt
procno = (prompt service >> 16) - com_sync1dest
if  procno = 1 then  s = ":" else  start 
if  procno = 3 then  s = "PROMPT OFF" else  c 
                     s = "XXX"
finish 
p_srce = 7
p_dest = prompt service
p_message = s.snl
dpon(p)
end ;   ! of clear pending prompts
!
!-----------------------------------------------------------------------
!
routine  await clock tick
! Wait for the pending clock tick to arrive, so that it doesn't suddenly
! arrive on another program run.
record (pe) p
!
cycle 
   p = 0
   dpoff(p)
   exit  if  (p_dest & x'ff') = 31
repeat 
end ;   ! of await clock tick
!
!-----------------------------------------------------------------------
!
routine  initialise terminal
integer  aitbuffer,aiostat,len,ad
string (255) work
!
console(13,aitbuffer,aiostat);          ! Get vital terminal addresses
if  aitbuffer = 0 then  start 
   printstring("Not an interactive terminal".snl)
   set return code(1000)
   stop 
finish 
!
command erase screen = vdus(1)
command erase line = vdus(3)
command move to prompt = vduc(40,21)
command move to input line = vduc(40,22)
command move to bottom line = vduc(40,23)
message status = uinfi(22)
messages("OFF")
prompt(tostring(cr))
iostat == record(aiostat)
it == record(aitbuffer)
oldmode = modestr
setmode("GRAPH,CANCEL=64");             ! Set cancel to '@'
work = vdus(5);                         ! Initialisation string
if  length(work) # 0 then  start 
   ad = addr(work) + 1
   len = length(work)
   console(10,ad,len)
finish 
end ;   ! of initialise terminal
!
!-----------------------------------------------------------------------
!
routine  finalise terminal
setmode(oldmode)
clear screen
if  message status = 0 then  start 
   messages("ON")
finish 
end ;   ! of finalise terminal
!
!-----------------------------------------------------------------------
!
routine  init resident pictures
integerarrayname  gpctab
!
gpctab == array(com_gpca,tablef)
!
resident picture(0) = gpctab(41);       ! 'L'
resident picture(1) = gpctab(42);       ! 'P'
resident picture(2) = gpctab(43) + 2048;! 'S'
resident picture(3) = gpctab(43) + 3072;! 'V'
end ;   ! of init resident pictures
!
!-----------------------------------------------------------------------
!
routine  init local pictures
integer  i
record (lpicf)name  lpic
!
for  i = first local picture,1,last local picture cycle 
   lpic == local picture(i)
   lpic = 0
repeat 
end ;   ! of init local pictures
!
!-----------------------------------------------------------------------
!
routine  init picture buffers
integer  screen,line,i
string (31) work
byteintegerarrayname  hd
record (scf)arrayname  buff
!
for  screen = 0,1,1 cycle 
   buff == array(addr(buffs(1,screen)_header(1)),scaf)
   for  line = 1,1,24 cycle 
      work = vduc((screen!!1)*40,line-1)
      hd == buff(line)_header
      if  length(work) > 8 then  start 
         printstring("Terminal not suitable".snl)
         set return code(1000)
         stop 
      finish 
      !
      for  i = 1,1,length(work) cycle 
         hd(i) = charno(work,i)
      repeat 
      hd(i) = null for  i = length(work)+1,1,8
   repeat 
   current picture(screen) = -1
   current page(screen) = -1
repeat 
end ;   ! of init picture buffers
!
!-----------------------------------------------------------------------
!
string (6)function  from(integer  source)
integer  proc, q, r
string (6) user
!
proc = (source >> 16) - com_sync1dest
result  = "" unless  proc > 0
q = (proc-1)//3
r = proc - 1 - 3*q
move(6,resident picture(1)+41*(q+5)+13*r+12,addr(user)+1)
length(user) = 6
etoi(addr(user)+1,6)
uctranslate(addr(user)+1,6)
result  = user
end ;   ! of from
!
!-----------------------------------------------------------------------
!
routine  transfer line(string (40) s)
integer  ad,len
string (255) work
!
work <- command move to bottom line.command erase line.s.c 
        command move to input line.command erase line
ad = addr(work) + 1
len = length(work)
console(10,ad,len)
end ;   ! of transfer line
!
!-----------------------------------------------------------------------
!
routine  update operlog(string (23) s)
record (pe) p
!
p_dest = oper service!update log act
p_srce = 0
p_message = s
dpon(p)
operlog altered = yes
end ;   ! of update operlog
!
!-----------------------------------------------------------------------
!
routine  report picture off(integer  owner,picture)
! A local picture is about to go off the screen.  Tell its owner that it
! need no longer be updated.
record (pe) p
!
p_dest = owner
p_picno = picture
dpon(p)
end ;   ! of report picture off
!
!-----------------------------------------------------------------------
!
routine  check picture off(integer  screen)
! A  screen  is  about  to be changed.  If it currently displays a local
! picture, report it off and disconnect it if it is  no  longer  on  any
! screen.
integer  picture,flag
record (lpicf)name  lpic
!
if  0 <= screen <= 1 then  start 
   picture = current picture(screen)
   if  first local picture <= picture <= last local picture then  start 
      lpic == local picture(picture)
      lpic_screens = lpic_screens - 1
      if  lpic_screens <= 0 then  start 
         sdisconnect(lpic_owner.".".lpic_file,lpic_fsys,flag)
         lpic = 0
      finish 
      report picture off(lpic_srce,lpic_hisno)
   finish 
finish 
end ;   ! of check picture off
!
!-----------------------------------------------------------------------
!
routine  oper message(string (40) mes,integer  doflash)
integer  l,max
string (23) s
!
if  doflash = yes then  max = 22 else  max = 23
cycle 
   s <- mes
   if  flash = yes then  charno(s,23) = flash
   update operlog(s)
   l = length(mes) - max
   exit  unless  l > 0
   length(mes) = l
   move(l,addr(mes)+max+1,addr(mes)+1)
repeat 
end ;   ! of oper message
!
!-----------------------------------------------------------------------
!
routine  local command(string (40) s)
integer  i,doflash
string (40) comm,param
switch  csw(1:maxlcom)
!
if  length(s) <= 1 then  start 
   transfer line(s)
   return 
finish 
s = substring(s,2,length(s))
!
comm = s
while  length(comm) # 0 and  charno(comm,1) = ' ' cycle 
   if  length(comm) = 1 then  comm = "" else  start 
      comm = substring(comm,2,length(comm))
   finish 
repeat 
s = s." ".comm while  s -> s.("  ").comm
unless  s -> comm.(" ").param then  start 
   comm = s
   param = ""
finish 
!
for  i = 1,1,maxlcom cycle 
   if  comm = lcom(i) then  -> csw(i)
repeat 
transfer line("** Illegal local command")
return 
!
csw(1):                                 ! (R)efresh rate
   if  param = "" then  start 
      refresh interval = default refresh interval
   else 
      i = pstoi(param)
      if  5 <= i <= 600 then  start 
         refresh interval = i
         transfer line("** OK")
      finish  else  transfer line("** Invalid value")
   finish 
   return 
   !
csw(2):                                 ! (M)essage to OPERLOG and (F)lash
   doflash = yes
   -> csw3a
   !
csw(3):                                 ! (M)essage to OPERLOG
   doflash = no
csw3a:
   oper message(param,doflash)
   transfer line("** Message sent")
   return 
   !
csw(4):                                 ! (U)sers - number of
   i = com_users - sysprocs
   i = 1 if  i < 1
   param = "** ".itos(i)." User"
   if  i > 1 then  param = param."s"
   transfer line(param)
   return 
   !
csw(5):                                 ! (S)econds per (T)ick
   if  param = "" then  start 
      seconds per tick = default seconds per tick
   else 
      i = pstoi(param)
      if  2 <= i <= 20 then  start 
         seconds per tick = i
         transfer line("** OK")
      finish  else  transfer line("** Invalid value")
   finish 
   clockp_p2 = seconds per tick
   return 
   !
end ;   ! of local command
!
!-----------------------------------------------------------------------
!
externalroutine  ontrap(integer  class,subclass)
integer  flag,i
!
console(7,flag,flag);                   ! Kill output
check picture off(i) for  i = 0,1,1;    ! Disconnect any local pictures
clear pending prompts
finalise terminal
if  clock status = running then  await clock tick
signal(3,class,subclass,flag);          ! Get the Subsystem to do the rest
end ;   ! of ontrap
!
!-----------------------------------------------------------------------
!
routine  set prompt(string (15) s,integer  srce)
promptstring <- s
if  srce # 0 then  start 
   srce = srce >> 16
   promptstring <- promptstring." from ".itos(srce-com_sync1dest)
finish 
end ;   ! of set prompt
!
!-----------------------------------------------------------------------
!
routine  display prompt
integer  ad,len
string (255) work
!
work <- command move to prompt.command erase line.promptstring.c 
        command move to input line
ad = addr(work) + 1
len = length(work)
console(10,ad,len)
end ;   ! of display prompt
!
!-----------------------------------------------------------------------
!
routine  display picture(integer  screen,picture,reqpage)
! Display page 'reqpage' of 'picture' on 'screen' of the virtual OPER.
integer  picad,size,ad,len,i,picmax,picsize,page
record (scf)arrayname  buff
!
return  unless  0 <= picture <= last local picture and  0 <= screen <= 1
if  picture < first local picture then  start 
   picad = resident picture(picture)
else 
   picad = local picture(picture)_addr
finish 
return  if  picad = 0
page = reqpage
page = initial page(picture) if  page = -1
!
len = integer(picad)
size = screen size(screen)
picsize = size*41
!
buff == array(addr(buffs(1,screen)_header(1)),scaf)
picad = picad + 8
picmax = picad + len
picad = picad + picsize*page
while  picad > picmax cycle ;           ! Picture may have shrunk
   picad = picad - picsize
   page = page - 1
repeat 
if  picad + picsize > picmax and  page > 0 then  picad = picmax - picsize
!
if  current picture(screen) = picture and  c 
    current page(screen) = page and  c 
    reqpage >= 0 then  return 
current picture(screen) = picture
current page(screen) = page
!
for  i = 1,1,size cycle 
   ad = addr(buff(i)_text(1))
   move(40,picad,ad)
   etoi(ad,40) if  picture < first local picture
                                        ! Local pictures are ISO
   picad = picad + 41
repeat 
!
ad = addr(buff(1))
len = size*48
console(10,ad,len)
if  picture = 0 then  operlog altered = no
end ;   ! of display picture
!
!-----------------------------------------------------------------------
!
routine  display new page(integer  screen,change)
integer  newpage
!
return  unless  0 <= screen <= 1
newpage = current page(screen) + change
if  newpage < 0 then  newpage = 0
display picture(screen,current picture(screen),newpage)
end ;   ! of display new page
!
!-----------------------------------------------------------------------
!
routine  readline(stringname  s)
integer  c,l
!
on  event  9 start ;                    ! Trap 'Input Ended'
   s = "*"
   return 
finish 
!
s = ""
cycle 
   readch(c)
   if  c = eom then  start 
      s = "*"
      return 
   finish 
   exit  if  c = nl
   s <- s.tostring(c)
repeat 
!
cycle 
   l = length(s)
   exit  if  l = 0 or  charno(s,l) # ' '
   length(s) = l - 1
repeat 
end ;   ! of readline
!
!-----------------------------------------------------------------------
!
integerfunction  same(integer  ad1,ad2)
*ldtb  _x'18000028';                    ! Byte descriptor, bound 40
*lda   _ad1;                            ! Form desc to first string
*cyd   _0;                              ! Copy to ACC for compare
*lda   _ad2;                            ! Form desc to second string
*cps   _l =dr ;                         ! Compare them
*jcc   _8,<equal>;                      ! Jump if they are the same
result  = no
!
equal:
result  = yes
end ;   ! of same
!
!-----------------------------------------------------------------------
!
routine  update picture(integer  picture)
integer  screen,picad,picmax,size,i,len,page,ad,copyad,picbase,picsize
integer  flag,from,to,step,adinc,uad
byteintegerarray  pcopy(1:24*41)
byteintegerarray  update buffer(1:24*48)
record (scf)arrayname  buff
!
return  unless  0 <= picture <= last local picture
if  picture < first local picture then  start 
   picbase = resident picture(picture)
else 
   picbase = local picture(picture)_addr
finish 
return  if  picbase = 0
len = integer(picbase)
picbase = picbase + 8
picmax = picbase + len
!
for  screen = 0,1,1 cycle 
   continue  unless  current picture(screen) = picture
   flag = no
   size = screen size(screen)
   picsize = size*41
   buff == array(addr(buffs(1,screen)_header(1)),scaf)
   page = current page(screen)
   picad = picbase + picsize*page
   while  picad > picmax cycle 
      picad = picad - picsize
      page = page - 1
   repeat 
   current page(screen) = page
   if  picad + picsize > picmax and  page > 0 then  picad = picmax - picsize
   copyad = addr(pcopy(1))
   move(picsize,picad,copyad)
   etoi(copyad,picsize) if  picture < first local picture
                                        ! Local pictures are ISO
   !
   if  picture = 0 then  start 
      from = size
      to = 1
      step = -1
      adinc = -41
      copyad = copyad + (size - 1)*41
   else 
      from = 1
      to = size
      step = 1
      adinc = 41
   finish 
   uad = addr(update buffer(1))
   for  i = from,step,to cycle 
      ad = addr(buff(i)_text(1))
      if  same(copyad,ad) = no then  start 
         flag = yes
         move(40,copyad,ad)
         move(48,addr(buff(i)_header(1)),uad)
         uad = uad + 48
      finish 
      copyad = copyad + adinc
   repeat 
   !
   if  flag = yes then  start ;         ! Fire the update
      ad = addr(update buffer(1))
      len = uad - ad
      console(10,ad,len)
      if  picture = 0 then  operlog altered = no
   finish 
repeat 
end ;   ! of update picture
!
!
!***********************************************************************
!*
!*          O P E R
!*
!***********************************************************************
!
externalroutine  oper(string (255) parms)
integer  flag,done useful work,dact,refresh counter,screen,i,l
integer  new prompt service,pic
string (6) owner
string (31) work1,work2
string (40) line
string (63) s
record (pe) p
record (rf) rr
record (lpicf)name  lpic
switch  act(0:31)
!
setpar(parms)
if  parmap > 1 then  start 
   flag = 263;                          ! Wrong number of parameters
   -> err
finish 
!
if  parmap = 1 then  start 
   work1 = spar(1);                     ! Refresh rate
   refresh interval = pstoi(work1)
   unless  5 <= refresh interval <= 600 then  start 
      flag = 202;                       ! Invalid parameter
      setfname(work1)
      -> err
   finish 
finish  else  refresh interval = default refresh interval
!
clock status = stopped
my sync1 dest = uinfi(7)
prompt service = 0
refresh counter = 0
seconds per tick = default seconds per tick
operlog altered = no
mon(vdus(0));                           ! Terminal name
init picture buffers
flag = dloweracr(2);                    ! Raise privilege
reroutecontingency(3,65,int mask,ontrap,flag)
                                        ! Catch INT: messages
initialise terminal
clear screen
init resident pictures
init local pictures
display picture(1,1,-1);                ! Display process list on screen 1
display picture(0,0,-1);                ! Display OPER log on screen 0
set prompt("COMMAND:",0)
display prompt
clockp_srce = 0
clockp_dest = elapsed int service!single kick act
clockp_p1 = my sync1 dest!31;           ! My activity number for reply
clockp_p2 = seconds per tick
dpon(clockp);                           ! Request initial clock tick
clock status = running
!
cycle 
   done useful work = no
   if  iostat_inpos # it_inpointer then  start 
                                        ! There is some input
      readline(line)
      if  length(line) # 0 or  prompt service # 0 then  start 
         exit  if  line = ".END" or  line = ".end" or  c 
                   line = "Q" or  line = "q" or  c 
                   line = "*"
         done useful work = yes
         if  length(line) # 0 and  charno(line,1) = '!' then  start 
            local command(line)
            continue 
         finish 
         length(line) = 23 if  length(line) > 23
         transfer line(line)
         new prompt service = 0
         if  prompt service = 0 then  start 
            p_dest = oper service!parse com act
         else 
            p_dest = prompt service
            update operlog(line)
            l = length(line)
            if  l # 0 and  charno(line,l) = '&' then  start 
               charno(line,l) = ' '
               set prompt("CONTINUE:",prompt service)
               new prompt service = prompt service
            else 
               if  l > 22 then  l = 22
               charno(line,l + 1) = nl
               length(line) = l + 1
               set prompt("COMMAND:",0)
            finish 
            display prompt
         finish 
         p_srce = 7
         p_message = line
         dpon(p)
         prompt service = new prompt service
                                        ! Done after 'dpon' in case of interruption
      finish  else  display prompt
   finish 
   p_dest = 0
   dtoff(p)
   if  p_dest = 0 and  done useful work = no then  dpoff(p)
   dact = p_dest & x'ff';               ! May be zero if the 'dtoff' didn't find anything
   !
   -> act(dact)
   !
act(0):                                 ! Null action
   continue 
   !
act(31):                                ! Clock tick
   clock status = stopped
   refresh counter = refresh counter + seconds per tick
   if  refresh counter >= refresh interval then  start 
      refresh counter = 0
      for  screen = 0,1,1 cycle 
         update picture(current picture(screen))
      repeat 
      display prompt
   else 
      if  operlog altered = yes then  start 
         update picture(0)
         display prompt
      finish 
   finish 
   dpon(clockp);                        ! Request fresh clock tick
   clock status = running
   continue 
   !
act(1):                                 ! Output string
act(7):                                 ! String to OPER log
   update operlog(p_message)
   continue 
   !
act(6):                                 ! Display local picture
   unless  0 <= p_screen <= 1 then  start 
                                        ! Screen out of bounds
      report picture off(p_srce,p_picno)
                                        ! Owner will have incremented refresh count
      continue 
   finish 
   !
   owner = from(p_srce);                ! For file handling
   !
   pic = current picture(p_screen);     ! Current contents of screen
   if  pic >= first local picture and  c 
       local picture(pic)_owner = owner and  c 
       local picture(pic)_file = p_file then  start 
      report picture off(p_srce,p_picno)
                                        ! Decrement refresh count as above
      continue 
   finish 
   !
   ! A new picture is about to go onto the requested screen
   !
   check picture off(p_screen);         ! It may be a local picture at present
   !
   ! Select a free local picture descriptor (there is always one)
   !
   i = first local picture
   cycle 
      lpic == local picture(i)
      if  lpic_screens > 0 then  start ;  ! In use
         exit  if  lpic_owner = owner and  lpic_file = p_file
      finish  else  l = i
      i = i + 1
      i = l and  exit  if  i > last local picture
   repeat 
   lpic == local picture(i)
   !
   if  lpic_screens <= 0 then  start ;  ! Not currently showing - connect it
      lpic_owner = owner
      lpic_file = p_file
      lpic_fsys = p_fsys
      connect(lpic_owner.".".lpic_file,9,0,(lpic_fsys<<8)!x'80',rr,flag)
      if  flag # 0 then  start 
         s = failuremessage(flag)
         s = substring(s,2,length(s))
         length(s) = 40 if  length(s) > 40
         transfer line(s)
         continue 
      finish 
      lpic_addr = rr_conad + 24;        ! Avoid header but keep length
      lpic_screens = 1
      lpic_hisno = p_picno
      lpic_srce = p_srce
   finish  else  lpic_screens = lpic_screens + 1
   display picture(p_screen,i,-1)
   display prompt
   continue 
   !
act(19):                                ! Request for picture change
   if  p_picno < 0 then  start ;        ! Translate symbolic picture name
      if  lpsv -> work1.(string(addr(p_p3))).work2 then  start 
         p_picno = length(work1)
      finish 
   finish 
   continue  if  p_picno >= first local picture
   check picture off(p_screen);         ! Screen may be showing a local picture
   display picture(p_p2,p_picno,-1)
   display prompt
   continue 
   !
act(18):                                ! Request for page change
   display new page(p_p2,p_picno)
   display prompt
   continue 
   !
act(8):                                 ! Prompt
   prompt service = p_srce
   set prompt(p_message,prompt service)
   display prompt
   continue 
repeat 
!
check picture off(i) for  i = 0,1,1
clear pending prompts
finalise terminal
if  clock status = running then  await clock tick
set return code(0)
return 
!
err:
printstring(snl."OPER fails -".failuremessage(flag))
set return code(flag)
stop 
end ;   ! of oper
endoffile