! DATED 11 NOV 1984
!***********************************************************************
!*
!* OPER handler for an interactive terminal
!*
!* Copyright (C) R.D. Eager University of Kent MCMLXXXI
!*
!* This version converted to IMP80 and interfaced to VVP -
!* the Virtual Video Package - by K. Yarwood, February 1982
!* Modified for VOLUMS local pictures - C.D.McArthur, September 1982
!*
!***********************************************************************
!
!
!***********************************************************************
!*
!* Constants
!*
!***********************************************************************
!
constinteger no = 0, yes = 1
constinteger stopped = 0, running = 1; ! Clock states
constbyteinteger null = x'00'
constbyteinteger cr = x'0D'
constbyteinteger flash = x'11'
constbyteinteger eom = x'19'
constbyteinteger escape = x'1B'
!
constinteger com seg = x'80C00000'; ! Address of Supervisor communication segment
constinteger default refresh interval = 10; ! Seconds
constinteger default seconds per tick = 3
!
constinteger elapsed int service = x'000A0000'
constinteger single kick act = 2
!
constinteger oper service = x'00320000'
constinteger update log act = 7
constinteger parse com act = 14
!
constlonginteger int mask = x'0382000A0382000A'; ! INT: A,C,Q,W,X,Y,a,c,q,w,x,y
!
constinteger maxlcom = 5; ! Number of local commands
conststring (2)array lcom(1:maxlcom) = "R","MF","M","U","ST"
!
conststring (1) snl = "
"
conststring (4) lpsv = "LPSV"
!
constinteger first loc pic=4, last loc pic=11; ! local pictures
!
constbyteintegerarray screen size(0:1) = 21,24
constbyteintegerarray initial page(0:last loc pic) = 2,0,0,0,0(8)
!
owninteger pr linex=41;owninteger pr liney=7
owninteger ip linex=41;owninteger ip liney=8
owninteger bo linex=41;owninteger bo liney=9
owninteger screen lines=10
!
!
!***********************************************************************
!*
!* Record and array formats
!*
!***********************************************************************
!
recordformat comf(integer ocptype,ipldev,sblks,sepgs,ndiscs,c
ddtaddr,gpctabsize,gpca,sfctabsize,sfca,sfck,dirsite,c
dcodeda,suplvn,wasklokcorrect,date0,date1,date2,c
time0,time1,time2,epagesize,users,cattad,dqaddr,c
byteinteger nsacs,resv1,sacport1,sacport0,c
nocps,resv2,ocpport1,ocpport0,c
integer itint,contypea,gpcconfa,fpcconfa,sfcconfa,c
blkaddr,dptaddr,smacs,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,sp0,sp1,c
sp2,sp3,sp4,sp5,sp6,sp7,sp8,c
lstl,lstb,pstl,pstb,hkeys,hoot,sim,clkx,clky,clkz,c
hbit,slaveoff,inhssr,sdr1,sdr2,sdr3,c
sdr4,sesr,hoffbit,s2,s3,s4,end)
record format tmodef(half integer flags, byte integer pads, spare, linelim, page,
byte integer array tabs(1:8), byte integer cr, esc, del, can, prompt, end,
half integer flags2, spare2, spare3, byte integer screed1, screed2, screed3, screed4,
screed5, screed6)
record format uinff(string (6) user, string (31) batchfile, integer mark, fsys, procno,
isuff, reason, batchid, sessiclim, scidensad, scidens, operno, aiostat, scdate, sync1dest,
sync2dest, asyncdest, aacctrec, aicrevs, string (15) batchiden, string (31) basefile,
integer previc, integer itaddr0, itaddr1, itaddr2, itaddr3, itaddr4, streamid, dident,
scarcity, preemptat, string (11) spoolrfile, integer resunits, sesslen, priority, decks,
drives, partclose, record (tmodef) tmodes, integer pslot, string (63) itaddr,
integer array fclosing(0:3), integer clo fes, uend)
const record (uinff) name uinf=9<<18
recordformat iostatf(integer inpos,string (15) intmess)
recordformat itf(integer inbase,inlength,inpointer,outbase,c
outlength,outpointer,outbusy,omwaiting,inttwaiting,c
jnbase,jncur,jnmax,lastfree,spare5,spare6,spare7)
recordformat parmf(integer dest,srce,p1,p2,p3,p4,p5,p6)
recordformat scf(byteintegerarray header(1:8),text(1:40))
recordformat loc pic f(string (6)owner,string (11)file,integer fsys,c
addr,screens,srce)
!
ownintegerarrayformat tablef(0:43)
ownrecord (scf)arrayformat scaf(1:24)
!
!
!***********************************************************************
!*
!* Owns
!*
!***********************************************************************
!
owninteger clock status
owninteger my sync1 dest
owninteger prompt service
owninteger refresh interval
owninteger seconds per tick
owninteger operlog altered
ownstring (40) promptstring
ownrecord (parmf)clockp
ownrecord (iostatf)name iostat
ownrecord (itf)name it
ownrecord (comf)name com
ownintegerarray current picture(0:1)
ownintegerarray current page(0:1)
ownintegerarray resident picture(0:3)
ownrecord (scf)array buffs(1:24,0:1)
ownrecord (loc pic f)array local picture(first loc pic:last loc pic)
!
!
!***********************************************************************
!*
!* Director references
!*
!***********************************************************************
!
externalstringfnspec derrs(integer n)
externalroutinespec messages(string (255) s)
externalintegerfnspec dloweracr(integer newacr)
externalroutinespec dpoff(record (parmf)name p)
externalroutinespec dpon(record (parmf)name p)
externalroutinespec dtoff(record (parmf)name p)
externalintegerfnspec dconnect(string (6)user,string (11)file,integer fsys,c
mode,apf,integername seg,gap)
externalintegerfnspec ddisconnect(string (6)user,string (11)file,c
integer fsys,destroy)
!
!
!***********************************************************************
!*
!* Subsystem references
!*
!***********************************************************************
!
systemroutinespec console(integer ep,integername start,len)
systemroutinespec etoi(integer ad,l)
systemstringfnspec itos(integer n)
systemroutinespec move(integer length,from,to)
externalroutinespec prompt(string (255) s)
systemintegerfnspec pstoi(string (63) s)
systemroutinespec reroutecontingency(integer ep,class,longinteger c
mask,routine ontrap,c
integername flag)
systemroutinespec signal(integer ep,p1,p2,integername flag)
externalintegerfnspec uinfi(integer entry)
systemroutinespec uctranslate(integer ad, len)
!
!
!**********************************************************************
!*
!* VVP references and consts
!*
!**********************************************************************
include "CONLIB.VVP_VVPSPECS"
include "CONLIB.VVP_VVPFORMATS"
!***********************************************************************
!*
!* Service routines
!*
!***********************************************************************
!
!
routine report pic off(integer owner,pic)
! local pic pic about to go off-screen. tell owner so that he can
! stop updating it
record (parmf)p
p_dest=owner
p_p1=pic
dpon(p)
end ; ! report pic off
!
routine check pic off(integer screen)
! we are about to change screen. if it currently shows a local pic
! then report it off and maybe disconnect
integer pic,flag
record (loc pic f)name lpic
returnunless 0<=screen<=1
pic=current picture(screen)
if pic>=first loc pic start
lpic==local picture(pic)
lpic_screens=lpic_screens-1
if lpic_screens=0 start ; ! all off
flag=ddisconnect(lpic_owner,lpic_file,lpic_fsys,0)
! what if flag#0 ??
finish
report pic off(lpic_srce,pic)
finish
end ; ! check pic off
!
routine clear pending prompts
integer procno
string (15) s
record (parmf)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
string(addr(p_p1)) = s.snl
dpon(p)
end ; ! of CLEAR PENDING PROMPTS
!
!
routine await clock tick
record (parmf)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,ad,mode
!
console(13,aitbuffer,aiostat); ! Get vital terminal addresses
if aitbuffer = 0 then start
vv printstring("Not an interactive terminal".snl)
stop
finish
!
prompt(tostring(cr))
iostat == record(aiostat)
it == record(aitbuffer)
end ; ! of INITIALISE TERMINAL
!
!
routine finalise terminal
vv define triggers(-2, 0, 0)
messages("ON")
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 (loc pic f)name lpic
for i=first loc pic,1,last loc pic cycle
lpic==local picture(i)
lpic=0
lpic_owner="VOLUMS"
repeat
end ; ! init local pictures
!
!
routine init picture buffers
integer screen,line
byteintegerarrayname hd
record (scf)arrayname buff
!
cycle screen = 0,1,1
buff == array(addr(buffs(1,screen)_header(1)),scaf)
cycle line = 1,1,24
hd == buff(line)_header
hd(1) = escape
hd(2) = 'X'
hd(3) = 0 {line address char(line)}
hd(4) = escape
hd(5) = 'Y'
hd(6) = (1-screen)*41 {screen address char(screen)}
hd(7) = null
hd(8) = null
repeat
current picture(screen) = -1
current page(screen) = -1
repeat
end ; ! of INIT PICTURE BUFFERS
!
!
routine transfer line(string (40) s)
vv goto(bo linex, bo liney)
vv printstring(s)
vv print ch(clr rol char)
vv goto(ip linex, ip liney)
vv printch(clr rol char)
end ; ! of TRANSFER LINE
!
!
routine update operlog(string (23) s)
record (parmf)p
!
p_dest = oper service!update log act
p_srce = 0
string(addr(p_p1)) = s
dpon(p)
operlog altered = yes
end ; ! of UPDATE OPERLOG
!
!
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)
!
return if length(s) <= 1
s = substring(s,2,length(s))
!
s = substring(s, 2, length(s)) while length(s)>1 and charno(s,1)=' '
s = s." ".comm while s -> s.(" ").comm
unless s -> comm.(" ").param then start
comm = s
param = ""
finish
!
cycle i = 1,1,maxlcom
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
finish else start
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 - 3
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
finish else start
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
!
!
routine ontrap(integer class,subclass)
integer flag
!
console(7,flag,flag); ! Kill output
check pic off(flag) for flag=0,1,1; ! local pics ?
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
vv goto(pr linex, pr liney)
vv printstring(promptstring)
vv printch(clr rol char)
vv goto(pr linex, pr liney + 1)
vv printch(clr rol char)
end ; ! of DISPLAY PROMPT
!
!
routine display picture(integer screen,picture,reqpage)
integer picad,size,ad,len,i,picmax,picsize,page,j
record (scf)arrayname buff
!
return unless 0 <= picture <= last loc pic and 0 <= screen <= 1
if picture<first loc pic then picad = resident picture(picture) c
else picad=local picture(picture)_addr
return if picad = 0
page = reqpage
if page = -1 then page = initial page(picture)
!
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 ; ! the picture may have shrunk
picad = picad - picsize; ! by several pages since we were here
page = page - 1; ! last, so get back into last page
repeat
if picad + picsize > picmax and page > 0 then picad = picmax - picsize
! we cant back up if the short last page is also the first page. we have to
! assume that there is at least one page addressable regardless of len.
!
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
!
size=screen lines if screen lines<size
cycle i = 1,1,size
ad = addr(buff(i)_text(1))
move(40,picad,ad)
etoi(ad,40) if picture<first loc pic; ! local pictures are ISO
! Output to VVP
vv goto(buff(i)_header(6), i-1)
for j=1,1,40 cycle
vv print ch(buff(i)_text(j))
repeat
picad = picad + 41
repeat
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)
s=""
vv rstrg(s)
uctranslate(addr(s)+1, length(s))
end ; ! of READLINE
!
!
integerfn 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,j
integer from,to,step,adinc,uad,ch{copy2ad
byteintegerarray p2copy(1:40)
byteintegerarray pcopy(1:24*41)
record (scf)arrayname buff
!
return unless 0 <= picture <= last loc pic
if picture<first loc pic then picbase = resident picture(picture) c
else picbase=local picture(picture)_addr
return if picbase = 0
len = integer(picbase)
picbase = picbase + 8
picmax = picbase + len
{opy2ad = addr(p2copy(1))
!
cycle screen = 0,1,1
continue unless current picture(screen) = picture
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)) {address for local copy of current state}
move(picsize,picad,copyad) {take copy of whole of resident picture}
etoi(copyad,picsize) if picture<first loc pic
!
if picture = 0 then start
from = size
to = 1
if screen lines<size then from=screen lines-3
step = -1
adinc = -41
copyad = copyad + (size - 1)*41
finish else start
from = 1
to = size
if screen lines<to then to=screen lines
step = 1
adinc = 41
finish
cycle i = from,step,to
ad = addr(buff(i)_text(1)) {address of program's copy of screen}
if same(copyad,ad) = no then start
move(40, copyad, ad) {move current value to program's copy}
! Send to VVP
vv goto(buff(i)_header(6), i-1)
for j=1,1,40 cycle
vv print ch(buff(i)_text(j))
repeat
finish
copyad = copyad + adinc
repeat
repeat
end ; ! of UPDATE PICTURE
!
!
!***********************************************************************
!*
!* O P E R
!*
!***********************************************************************
!
externalroutine oper(string (255) parms)
integer flag,done useful work,dact,l,refresh counter,screen,seg,gap,pic
integer new prompt service
string (31) work1,work2
string (40) line
record (parmf)p
record (loc pic f)name lpic
record (boxf)name box
record (subscrf) screenrec
record (subscrf) name scr
switch act(0:31)
routine otx
printstring("
");printstring("Screen operations are currently not possible on PAD connections to EMAS.
");printstring("Development of the JNT-sponsored screen protocol SSMP is awaited (November 1984)
");printstring("Perhaps your conversion to a PAD port was premature.
");
end {otx}
messages("OFF")
if parms="" start
work1<-string(uinf_itaddr)
flag=1 {set to zero if any non-numeric found in ITADDR}
for l=1, 1,length(work) cycle
unless '0'<=charno(work, l)<='9' then flag=0
repeat
if flag=0 start
otx
return
finish
vv init(l)
if l#0 start {failure to init }
printstring("Cannot run OPER on this terminal type")
newline
return
finish
vv define triggers(3, 0, 0) {allow left-right cursor movement only}
finish {%else %start
scr==record(vv screen descriptor address)
screenrec=scr
box==screenrec_box
pr linex=box_wid-24; bo liney=box_dep-1
pr linex=41 if pr linex>41
ip linex=pr linex ; ip liney=bo liney-1
bo linex=pr linex ; pr liney=ip liney-1
screen lines=box_dep
!finish
clock status = stopped
com == record(com seg)
my sync1 dest = uinfi(7)
prompt service = 0
refresh counter = 0
refresh interval = default refresh interval
seconds per tick = default seconds per tick
operlog altered = no
flag = dloweracr(2); ! Raise privilege
reroutecontingency(3,65,int mask,ontrap,flag); ! Catch INT: messages
initialise terminal
init picture buffers
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
vv update screen
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 = "*" or line = "Q" or c
line="QUIT" or line="STOP" or line="END" or line="FINISH" or c
line="LOG" or line="LOGOFF"
done useful work = yes
if charno(line,1) = '!' then start
local command(line)
continue
finish
if length(line) > 23 then length(line) = 23
transfer line(line)
new prompt service = 0
if prompt service = 0 then start
p_dest = oper service!parse com act
finish else start
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
finish else start
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
string(addr(p_p1)) = line
dpon(p)
prompt service = new prompt service {Done after PON in case of interruption}
finish else display prompt
finish
p_dest = 0
dtoff(p)
if p_dest = 0 and done useful work = no then vv update screen and dpoff(p)
dact = p_dest & x'FF'; ! May be zero if the TOFF 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
cycle screen = 0,1,1
update picture(current picture(screen))
repeat
display prompt
finish else start
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(string(addr(p_p1)))
continue
!
act(6): ! display a local picture
! p1=picture number, p2=fsys for file, p3=screen, p4,5,6=filename
unless 0<=p_p3<=1 start ; ! screen out of bounds
report pic off(p_srce,p_p1); ! owner will have incremented refresh count
continue
finish
pic=current picture(p_p3); ! whats showing
if pic=p_p1 start ; ! already there
report pic off(p_srce,p_p1); ! as above
continue
finish
! so a new picture about to go on screen p_p3
check pic off(p_p3); ! it may be a local
! now the new one
lpic==local picture(p_p1)
if lpic_screens=0 start ; ! not currently showing. so connect it
lpic_file=string(addr(p_p4))
lpic_fsys=p_p2
seg=0
gap=0
flag=dconnect(lpic_owner,lpic_file,lpic_fsys,9,0,seg,gap)
if flag#0 start
transfer line(derrs(flag))
continue
finish
lpic_addr=seg<<18+24; ! where the length is
lpic_screens=1
lpic_srce=p_srce
finishelse lpic_screens=lpic_screens+1
display picture(p_p3,p_p1,-1)
display prompt
continue
!
act(19): ! Request for picture change
if p_p1 < 0 then start ; ! Translate symbolic picture name
if lpsv -> work1.(string(addr(p_p3))).work2 then start
p_p1 = length(work1)
finish
finish
if p_p1>=first loc pic thencontinue ; ! not this way
check pic off(p_p2); ! may be a local pic about to go off
display picture(p_p2,p_p1,-1)
display prompt
continue
!
act(18): ! Request for page change
display new page(p_p2,p_p1)
display prompt
continue
!
act(8): ! Prompt
prompt service = p_srce
set prompt(string(addr(p_p1)),prompt service)
display prompt
continue
repeat
!
check pic off(flag) for flag=0,1,1
clear pending prompts
finalise terminal if parms=""
if clock status = running then await clock tick
end ; ! of OPER
endoffile