external routine ttypes(string (255) s)
const integer acr= 7
const integer try= 38
!
external routine spec phex alias "S#PHEX"(integer i)
external routine spec getavfsys(integer name n, integer array name a)
external integer fn spec getusnames(integer name n, integer adr, fsys)
external integer fn spec dsfi(string (6) u, integer f, t, s, a)
external integer fn spec dpermission(string (6) own, user, string (8) date,
string (11) file, integer fsys, type, adr)
!
!
integer nsys, fsys, f, adr, nu, j, k, n
integer u, ap, pn, i
record format f1(string (6) u, byte integer prm)
record format f2(integer n, o, e, x, record (f1) array ip(0:15))
record (f2) p
record (f1) name ip
integer array a(0:99)
integer array fld(0:15)
string name u1
byte integer array unames(0:2400)
!
external integer fn spec dconnect(string (6) user, string (11) file, integer fsys, mode,
apf, integer name seg, gap)
external integer fn spec ddisconnect(string (6) user, string (11) file, integer fsys,
destroy)
external integer fn spec dfsys(string (6) user, integer name fsys)
external string fn spec itos alias "S#ITOS"(integer n)
external string fn spec uinfs(integer n)
const integer kshift= 10
const integer maxvkey= 17
const integer maxkey= 14
const string (8) tempoptions= "T#OPTION"
const integer maxsearchdircount= 16
const string (13) array vkey(1:maxvkey)= c
"INITSTACKSIZE","AUXSTACKSIZE","USERSTACKSIZE",
"ITWIDTH","FSTARTFILE","BSTARTFILE",
"PRELOADFILE","ACTIVEDIR","REMOVEDIR","SEARCHDIR","ARRAYDIAG",
"INITWORKSIZE","NULL","ITINSIZE","ITOUTSIZE","CFAULTS","TERMINAL"
const string (12) array key(1:maxkey)= c
"BRACKETS","NOBRACKETS","NORECALL","TEMPRECALL","PERMRECALL",
"NOFSTARTFILE","?","NOBLANKLINES","BLANKLINES","NOBSTARTFILE",
"INITPARMS","NOECHO","PARTECHO","FULLECHO"
routine outi(string (255) s, integer n)
constinteger maxn=29
conststring (39) array tnames(0:maxn)=c
" 0 unspecified ",
" 1 Hardcopy, width 72 ",
" 2 Hardcopy, width 80 ",
" 3 Hardcopy, width 132 ",
" 4 Unspecified Video ",
" 5 ITT ",
" 6 Perkin-Elmer 550 ",
" 7 Lynwood ",
" 8 VT52 ",
" 9 Apple, Sirius, SuperBrain, Terak",
"10 ADM-3a ",
"11 Visual 200 ",
"12 VT105 ",
"13 Hazeltine Esprit ",
"14 Hazeltine 1500 ",
"15 Newbury ",
"16 Pericom ",
"17 Tektronix 4010 ",
"18 IBM 3101 ",
"19 Dacoll 242E ",
"20 Volker Craig 404 ",
"21 ICL KDS7362 ",
"22 Hazeltine Esprit II ",
"23 Hazeltine Esprit III ",
"24 ADM-5 ",
"25 Visual 50 & 55 ",
"26 Tektronix 4014 ",
"27 Datatype X5A ",
"28 ANSI compatible ",
"29 BBC "
ownintegerarray tys(0:maxn)
owninteger tot
integer j, w, c
if n=-1 start
! Deliver the information
for j=0,1, maxn cycle
printstring(tnames(j))
write(tys(j), 1)
spaces(5)
w=(tys(j)*100)//tot
if w<10 then c=2 else c=1
write(w, c); printstring("%")
newline
repeat
printstring("[Total number of OPTION files ="); write(tot, 1)
printstring("]")
newline
return
finish else if not (0<=n<=maxn)start
printstring("INVALID TERMINALTYPE")
newline
monitor
stop
finish
tys(n)=tys(n)+1
tot=tot+1
! printstring(s." :")
! write(n, 1)
! newline
end ; !OF OUTI
routine outs(string (255) s, t)
printstring(s." : ".t)
newline
end ; !OF OUTS
!
!
!
const string (9) array parms(0:63)= c
"","I8","L8","R8",""(4),"MAXDICT",""(5),"MINSTACK",""(17),
"QUOTES", "NOLIST", "NODIAG", "STACK",
"NOCHECK", "NOARRAY", "NOTRACE", "PROFILE",
"IMPS", "INHIBIOF", "ZERO", "XREF",
"LABELS", "LET", "CODE", "ATTR",
"OPT", "MAP", "DEBUG", "FREE",
"DYNAMIC","","EBCDIC","NOLINE",
""(2),"PARMZ","PARMY",
"PARMX","MISMATCH",""(2)
routine printparms(long integer p)
integer i, found
found=0
for i=0, 1, 63 cycle
if p&1=1 start
if parms(i)#"" start ; !IGNORE BLANK PARMS
if found=0 then found=1 else printsymbol(',')
printstring(parms(i))
finish
finish
p=p>>1
repeat
if found=0 then printstring("DEFAULTS")
end ; !OF PRINTPARMS
!
!
!
record format contf(integer dataend, datastart, psize, filetype, sum, datetime, spare1,
spare2, mark, null1, ugla, astk, ustk, null2, itwidth, ldelim, rdelim, journal,
searchdircount, arraydiag, initworksize, spare, itinsize, itoutsize, nobl, istk,
long integer initparms, integer dataecho, terminal, i23, i24, i25, i26, i27, i28, i29, i30,
i31, i32, string (31) fstartfile, bstartfile, preloadfile, moddir, cfaults, s6, s7, s8, s9,
s10, s11, s12, s13, s14, s15, s16, s17, s18, s19, s20, s21, s22, s23, s24, s25, s26, s27, s28,
s29, s30, s31, s32, string (31) array searchdir(1:16))
!1/2/79
!
!
!
routine opt(integer fsys, string (6) user)
integer j, seg, gap
integer dpflag, dcflag
string (6) self
string (11) file
record (contf) name c
string (63) value, keyword, param
integer i, conad, flag, ivalue, mode, oldflag
switch sw(1:maxkey)
switch vsw(1:maxvkey)
file="SS#OPT"
self=uinfs(1)
!
dpflag=dpermission(user, self, "", "", fsys, 7, 0)
j=dpermission(user, self, "", "", fsys, 6, 1)
->out unless j=0
!
seg=0
gap=0
dcflag=dconnect(user, file, fsys, 1, 0, seg, gap)
->out1 if 34#dcflag#0
!
c==record(seg<<18)
!
j=c_terminal
outi(user, j) unless j<0
out1:
j=ddisconnect(user, file, fsys, 0) if dcflag=0
out:
j=dpermission(user, self, "", "", fsys, 7, 0) if dpflag=50
end
ap=addr(p)
adr=addr(unames(0))
get av fsys(nsys, a)
cycle f=0, 1, nsys-1
fsys=a(f)
printstring("FSYS")
write(fsys, 1)
newline
j=getusnames(nu, adr, fsys)
if nu>0 start
cycle u=0, 7, (nu-1)*7
u1==string(adr+u)
opt(fsys, u1)
repeat
finish
repeat
outi("", -1)
end
end of file