!***********************************************************************
!*
!* Command for users to try new basefile
!*
!* R.D. Eager University of Kent MCMLXXXIV
!*
!***********************************************************************
!
!
!***********************************************************************
!*
!* Constants
!*
!***********************************************************************
!
constantstring (1) snl = "
"
constantstring (31) oldbasefile = "SUBSYS.BASE0213B"
constantstring (31) newbasefile = ""
!
!
!***********************************************************************
!*
!* Subsystem references
!*
!***********************************************************************
!
systemstringfunctionspec failuremessage(integer mess)
systemintegerfunctionspec parmap
systemroutinespec setfname(string (63) s)
systemroutinespec setpar(string (255) s)
externalroutinespec set return code(integer i)
systemstringfunctionspec spar(integer n)
externalintegerfunctionspec uinfi(integer entry)
externalstringfunctionspec uinfs(integer entry)
!
!
!***********************************************************************
!*
!* Director references
!*
!***********************************************************************
!
externalintegerfunctionspec dsfi(string (6) user,integer fsys,type,
set,adr)
!
!
!***********************************************************************
!*
!* C H A N G E S S
!*
!***********************************************************************
!
externalroutine changess(string (255) parms)
integer flag
string (31) basefile
!
setpar(parms)
if parmap # 1 then start
flag = 263; ! Wrong number of parameters
-> err
finish
!
basefile = spar(1)
!
if basefile = "?" then start
printstring("Command is: CHANGESS(OLD) or CHANGESS(NEW)".snl)
else
if basefile = "OLD" then basefile = oldbasefile else c
if basefile = "NEW" then basefile = newbasefile else start
setfname(parms)
flag = 202; ! Invalid parameter
-> err
finish
!
flag = dsfi(uinfs(1),uinfi(1),0,1,addr(basefile))
if flag # 0 then start
flag = flag + 500
-> err
finish
finish
!
set return code(0)
return
!
err:
set return code(flag)
printstring(snl."CHANGESS fails -".failuremessage(flag))
stop
end ; ! of changess
endoffile