!***********************************************************************
!*
!* SETMODE command and support
!*
!* University of Kent version
!*
!* R.D. Eager University of Kent MCMLXXXIV
!*
!***********************************************************************
!
!
!***********************************************************************
!*
!* Constants
!*
!***********************************************************************
!
constantinteger no = 0, yes = 1
constantinteger modelim = 23; ! Number of different PAD mode settings
constantinteger tablim = 16; ! Number of PAD tab stops
constantinteger nfortabs = 10; ! Action code for TABS setting
constantstring (1) snl = "
"
constantstring (15)array mode text(1:modelim) = c
"Echo","Page size","Max line","","","",
"Delete char","Cancel char","Binary input","Tab setting",
"Graph mode","","","No of pad chars",
"Video mode","","Flow control","","","","Hard tab mode","",""
constantstring (9)array fname('A':'X') = c
"","BINARY","CANCEL","DELETE","ECHO","FLOW","GRAPH","HEIGHT",
"","","","","","","","PADS",
"","","","TABS","","VIDEO","WIDTH","XTABS"
!
! PAD setting codes. Action = (type << 8) ! function number
!
! Types 0-8 require different parameters.
constanthalfintegerarray action('A':'X') = c
x'000', x'209', x'308', x'307', x'201', x'211', x'20b', x'402',
x'000', x'000', x'000', x'000', x'000', x'000', x'000', x'50e',
x'000', x'000', x'000', x'80a', x'000', x'20f', x'603', x'215'
! A B C D E F G H
! I J K L M N O P
! Q R S T U V W X
constantbyteintegerarray tabdefaults(0:tablim-1) = c
1,6,9,12,15,18,40,80,160(8)
constantbyteintegerarray lower(3:6) = c
0,3,0,0
constantbyteintegerarray upper(3:6) = c
255,255,7,255
constantbyteintegerarray style(1:modelim) = c
{ This array gives the style in which each PAD }
{ mode value should be printed:- }
{ 0 - As an ON/OFF value }
{ n - As n bytes of parameters }
{ 255 - It should be ignored }
0, 1, 1, 255, 255, 255, 1, 1, 0,tablim,
0, 255, 255, 1, 0, 255, 0, 255, 255, 255,
0, 255, 255
constantbyteintegerarray keyindex(1:modelim) = c
{ This array gives the index in the 'fname' }
{ array of the appropriate keyword for each PAD }
{ mode byte. A value of 255 indicates that no }
{ keyword exists, and no setting is required. }
'E','H','W',255,255,255,'D','C','B','T','G',255,255,'P','V',255,'F',
255,255,255,'X',255,255
constantbyteintegerarray defaults(1:modelim) = c
{ This array gives the default setting for each }
{ PAD mode byte. A value of 255 indicates that }
{ a particular mode setting is not affected by }
{ a 'reset to defaults'. }
1, 24, 80,255,255,255, 127, 24, 0,255, 0,255,255, 0, 1,255, 0,
255,255,255, 0,255,255
!
!
!***********************************************************************
!*
!* Subsystem references
!*
!***********************************************************************
!
systemroutinespec console(integer ep,integername start,len)
systemstringfunctionspec failuremessage(integer mess)
systemstringfunctionspec itos(integer n)
systemintegerfunctionspec parmap
systemintegerfunctionspec pstoi(string (63) s)
systemroutinespec setfname(string (63) s)
systemroutinespec setpar(string (255) s)
externalroutinespec set return code(integer i)
systemstringfunctionspec spar(integer n)
!
!
!***********************************************************************
!*
!* Director references
!*
!***********************************************************************
!
externalstringfunctionspec derrs(integer n)
externalintegerfunctionspec dmode(integer set,adr,command)
!
!
!***********************************************************************
!*
!* Service routines
!*
!***********************************************************************
!
routine dmode error(integer flag)
printstring("Flag =".derrs(flag)." from DMODE".snl)
end ; ! of dmode error
!
!-----------------------------------------------------------------------
!
string (31)function string for(integer i,value)
integer k,m
string (31) res
!
k = keyindex(i); ! Get index of correct keyword
m = style(i); ! Get style of setting
if k = 255 or m > 1 then result = "" else start
if m = 1 then res = itos(value) else c
if value = 0 then res = "OFF" else res = "ON"
result = fname(k)."=".res
finish
end ; ! of string for
!
!-----------------------------------------------------------------------
!
string (127)function string for tabs(byteintegerarrayname x)
integer i,j
string (127) res,work1,work2
!
res = ""
for i = 0,1,tablim-1 cycle
j = x(i)
if i # 0 and j <= x(i-1) then res = res."*:" and exit
res = res.itos(j).":"
repeat
length(res) = length(res) - 1; ! Lose trailing colon
if res -> work1.("1:").work2 then start
res = work2 if work1 = ""
finish
result = fname(keyindex(nfortabs))."=".res
end ; ! of string for tabs
!
!-----------------------------------------------------------------------
!
routine do setmode(string (255) s,integer sync,string (8) name)
integer flag,type,letter,i,j,par,fno,astart,pt,tabptr,binmark
integer new stream mode
string (63) next,param,function,tab
byteintegerarray area(0:63)
byteintegerarray parlist(-1:tablim-1)
switch sw(1:8)
!
setpar(s)
!
flag = 0
binmark = 0
tabptr = -1; ! No tabs defined yet
astart = addr(area(0))
pt = 1
!
if parmap = 0 then start
area(pt) = 28; ! Function for reset to defaults
area(pt+1) = 0; ! Null qualifier byte
pt = pt + 2
-> set
finish
!
cycle
if pt > 53 then start
flag = 215; ! Too many parameters
-> err
finish
next = spar(0); ! Get next parameter
if next = "" then exit ; ! End of list
flag = 0
letter = charno(next,1)
if letter = '-' then start
-> perr if length(next) = 1
next = substring(next,2,length(next))."=OFF"
letter = charno(next,1)
finish
-> perr unless 'A' <= letter <= 'X' and action(letter) # 0
type = action(letter) >> 8
fno = action(letter) & x'ff'
if type > 1 then start ; ! i.e. parameter required
unless next -> function.("=").param then start
-> perr unless type = 2
param = "ON"
function = next
finish
else
function = next
par = 0
finish
-> perr if length(function) > 1 and function # fname(letter)
! Check full name
area(pt) = fno
-> sw(type)
!
sw(2): ! Echo, Binary, Video, Xtabs, Graph, Flow
! Param = ON, OFF
if param = "ON" then par = 1 else start
if param = "OFF" then par = 0 else -> perr
finish
if letter = 'G' then start
if par = 0 then start
new stream mode = 1; ! Circular ISO
else
new stream mode = x'21'; ! Circular binary
finish
finish
if letter = 'B' and length(function) = 1 then -> perr
! Only allow full name
if letter = 'B' or letter = 'G' then binmark = par + 1
! 0=unchanged, 1=ISO, 2=binary
-> note params
!
sw(3): ! Cancel, Delete (1-255)
sw(4): ! Height (3-255)
sw(5): ! Pads (0-100)
sw(6): ! Width (15-160)
par = pstoi(param); ! Parameter is number
if lower(type) <= par <= upper(type) then -> note params
! Check range
if type = 4 and par = 0 then -> note params
! HEIGHT=0 is also OK
-> perr
!
sw(8): ! Tabs
! Parameter is list of numbers
parlist(-1) = area(pt); ! Fill in function code
tabptr = 0
parlist(0) = 1
if param # "*" then start
while param # "*" cycle ; ! Look out for terminator
unless param -> tab.(":").param then start
tab = param
param = ""
finish
tabptr = tabptr + 1
parlist(tabptr) <- pstoi(tab)
-> perr if parlist(tabptr) < 0
! Invalid number
if tabptr = tablim-1 then start
! Should be empty now
if param = "" then exit else -> perr
finish
-> perr if param = ""; ! Incomplete list
repeat
!
for j = 1,1,tabptr cycle ; ! Check range and sequence
unless parlist(j-1) < parlist(j) <= 160 then -> perr
repeat
finish
if tabptr < tablim-1 then start ; ! Fill rest of tab vector
i = 0
i = i + 1 while tabdefaults(i) <= parlist(tabptr) and i < tablim
for tabptr = tabptr+1,1,tablim-1 cycle
parlist(tabptr) = tabdefaults(i)
i = i + 1 unless i = tablim
repeat
finish
continue
!
note params: ! Not done for Tabs
area(pt+1) = par; ! Insert single parameter
pt = pt + 2
continue
!
perr: ! Indicate invalid parameter
flag = 202
if length(next) > 40 then start
length(next) = 37
next = next."..."
finish
setfname(next)
-> err
!
repeat
!
if tabptr >= 0 then start ; ! Tab vector set
if pt > 44 then start
flag = 215; ! Too many parameters
-> err
else
for i = -1,1,tablim-1 cycle
area(pt) = parlist(i)
pt = pt + 1
repeat
finish
finish
!
set:
!
if pt > 1 then start ; ! Something to send
area(0) = pt - 1
if sync = no then start
if binmark # 0 then console(18,binmark,i)
! Change FEP stream mode
flag = dmode(1,astart,0)
if flag # 0 then start
flag = 309 if flag = 29; ! Out of CONLIST entries
setfname(derrs(flag))
flag = 233; ! General error
finish
else
console(17,astart,new stream mode)
finish
finish
!
err:
if flag # 0 then printstring(snl.name." fails -".failuremessage(flag))
set return code(flag)
end ; ! of do setmode
!
!
!***********************************************************************
!*
!* S E T M O D E
!*
!***********************************************************************
!
externalroutine setmode(string (255) parms)
do setmode(parms,no,"SETMODE")
end ; ! of setmode
!
!
!***********************************************************************
!*
!* X S E T M O D E
!*
!***********************************************************************
!
externalroutine xsetmode(string (255) parms)
do setmode(parms,yes,"XSETMODE")
end ; ! of xsetmode
!
!
!***********************************************************************
!*
!* R E Q U E S T M O D E S
!*
!***********************************************************************
!
systemroutine requestmodes
! Forces the copy of the PAD modes actually held in the PAD to be
! transmitted to the mainframe and stored. At Kent, this routine is not
! needed: however, it is included for compatibility with ERCC.
end ; ! of requestmodes
!
!
!***********************************************************************
!*
!* Q U E R Y M O D E
!*
!***********************************************************************
!
systemintegerfunction query mode(integer i)
integer flag
byteintegerarray aa(0:tablim)
!
if 0 <= style(i) <= 1 then start
flag = dmode(0,addr(aa(0)),i)
result = aa(0) if flag = 0
dmode error(flag)
finish
result = -1
end ; ! of query mode
!
!
!***********************************************************************
!*
!* Q U E R Y T A B S
!*
!***********************************************************************
!
systemintegerfunction query tabs(byteintegerarrayname x)
integer flag
!
flag = dmode(0,addr(x(0)),nfortabs)
if flag = 0 then result = 0 else start
dmode error(flag)
result = -1
finish
end ; ! of query tabs
!
!
!***********************************************************************
!*
!* M O D E S T R
!*
!***********************************************************************
!
externalstring (255)function modestr
integer i
string (63) txt
string (255) totxt
byteintegerarray aa(0:tablim)
!
totxt = ""
for i = 1,1,modelim cycle
if style(i) # 255 then start
if 0 <= style(i) <= 1 then start
txt = stringfor(i,query mode(i))
if txt # "" then totxt = totxt.txt.","
finish
finish
repeat
if query tabs(aa) = 0 then start
totxt = totxt.string for tabs(aa)
finish else length(totxt) = length(totxt) - 1
result = totxt
end ; ! of modestr
!
!
!***********************************************************************
!*
!* G E T M O D E
!*
!***********************************************************************
!
externalroutine getmode(string (255) parms)
integer i,k,all,flag
byteintegerarray aa(0:tablim)
string (63) txt
!
setpar(parms)
if parmap > 1 then start
flag = 215; ! Too many parameters
-> err
finish
if parmap = 1 then start
parms = spar(1)
unless parms = "*" or parms = "S" then start
setfname(parms)
flag = 202; ! Invalid parameter
-> err
finish
finish
if parms = "*" then all = yes else all = no
!
if parms = "S" then start
printstring(modestr.snl)
flag = 0
-> err
finish
!
for i = 1,1,modelim cycle
if style(i) # 255 then start
txt = mode text(i)
if 0 <= style(i) <= 1 then start
k = query mode(i)
if k # defaults(i) or all = yes then start
printstring(txt)
spaces(18-length(txt))
txt = stringfor(i,k)
if txt # "" then printstring(txt) else start
if style(i) # 0 then printstring(itos(k)) else c
if k = 0 then printstring("Off") else c
printstring("On")
finish
newline
finish
finish else c
if i = nfortabs and query tabs(aa) = 0 then start
k = 0
if all = yes then k = -1 else start
while k < tablim and aa(k) = tabdefaults(k) cycle
k = k + 1
repeat
if k = tablim then k = 0 else k = -1
finish
if k # 0 then start
printstring(txt)
spaces(18-length(txt))
printstring(string for tabs(aa).snl)
finish
finish
finish
repeat
flag = 0
!
err:
if flag # 0 then printstring(snl."GETMODE fails -".failuremessage(flag))
set return code(flag)
end ; ! of getmode
endoffile