!***********************************************************************
!* IMP80 March 1982
!*
!* REROUTE (version 4)  -  reroute output from a batch job
!*                              P. W. Riley. (C) U.K.C 1980
!*
!***********************************************************************
!*
recordformat  rf(integer  conad,filetype,datastart,dataend)
recordformat  fdf(integer  link,dsnum,byteinteger  status,accessroute,c 
    valid action,cur state,byteinteger  mode of use,c 
    mode,file org,dev code,byteinteger  rec type,flags,c 
    lm,rm,integer  asvar,arec,recsize,minrec,maxrec,c 
    maxsize,lastrec,conad,currec,cur,end,transfers,c 
    darecnum,cursize,datastart,string (31) iden)
recordformat  frf(integer  conad, filetype, datastart, dataend, c 
    size, rup, eep, mode, users, arch, string (6) tran, c 
    string (8) date, time, integer  count, spare1, spare2)
!*
systemroutinespec  disconnect(string (31) file,integername  flag)
systemroutinespec  rename(string (31) file,newfile,integername  flag)
systemroutinespec  newgen(string (31) file,newfile,integername  flag)
systemroutinespec  connect(string (31) file,integer  mode,hole,c 
    prot,record (rf)name  r,integername  flag)
systemroutinespec  setuse(string (31) file,integer  mode,value)
systemroutinespec  finfo(string (31) file, integer  mode, c 
    record (frf)name  fr, integername  flag)
systemintegerfnspec  fdmap(integer  chan)
systemintegerfnspec  devcode(string (16) device)
systemstringfnspec  failuremessage(integer  mess)
systemroutinespec  setfname(string (40) name)
externalroutinespec  set return code(integer  i)
externalintegerfnspec  uinfi(integer  entry)
externalstringfnspec  uinfs(integer  entry)
externalintegerfnspec  dmessage2(string (6) user, integername  len, c 
    integer  act, invoc, fsys, adr)
externalroutinespec  dstop(integer  reason)
externalintegerfnspec  dfstatus(string (6) user,string (11) file, c 
    integer  fsys, act, val )
!*
routine  abort(string (255) m)
    integer  s,l
    m = "Batch job reroute fails:
".m
    s = addr(m)+1
    l = length(m)
    s = dmessage2(uinfs(1),l,1,0,uinfi(1),s)
    dstop(100)
end 
routine  fail(string (255) s)
    printstring("REROUTE fails - ")
    printstring(s);newline
    setreturncode( 213 )
    stop 
end 
routine  change name(record (fdf)name  fd, string (31) newname)
    integer  flag, mode
    record (rf) rr
    record (frf) fr
    !*
    finfo(newname, 0, fr, flag)
    if  flag = 0 start 
        if  fr_arch # 0 start ;     ! file is cherished or archive pending
            flag = 219; setfname( newname )
        finish 
    finish 
    if  0 # flag # 218 then  fail(failuremessage(flag))
    mode = flag
    rr_conad = fd_conad
    setuse(fd_iden,0,0);  ! clear use count
    disconnect(fd_iden,flag)
    if  flag # 0 then  abort("DISCONNECT: ".failuremessage(flag))
    if  mode = 218 start 
        rename(fd_iden,newname,flag)
        if  flag # 0 then  abort("RENAME: ".failuremessage(flag))
    finish  else  start 
        newgen(fd_iden,newname,flag)
        if  flag # 0 then  abort("NEWGEN: ".failuremessage(flag))
    finish 
    connect(newname, 3, fd_maxsize, x'40', rr, flag)
    if  flag # 0 then  abort("CONNECT: ".failuremessage(flag))
    fd_iden = newname
    fd_devcode = 0
    setuse(newname,0,1);  ! mark as used
end 
externalroutine  reroute(string (255) s)
    integer  flag,devno
    record (fdf)name  fd
    record (fdf)name  nfd
    !*
    if  uinfi(2) # 2 then  fail("Not running in batch")
    fd == record(fdmap(91)); ! get primary output stream
    if  fd_accessroute = 10 start ;                         ! was to .NULL
        flag = dfstatus(uinfs(1),fd_iden,uinfi(1),5,1);     ! make permanent
        fd_accessroute = 8;                                 ! a file/device
    finish 
    if  length(s) > 0 and  charno(s,1) = '.' start ;   ! reroute to a device
        if  s = ".NULL" start ;  ! set accessroute = 10, make temporary
            flag = dfstatus(uinfs(1),fd_iden,uinfi(1),5,0)
            fd_accessroute = 10
            fd_devcode = 0
        finish  else  if  s = ".LP" start 
            ! nasty - cant just set as with other printers
            nfd == record(fdmap(90))
            s = nfd_iden
            s = "JO#".substring(s,8,length(s))
            change name(fd,s)
        finish  else  start 
            devno = devcode( s );   ! convert to a device code number
            if  devno <= 0 then  fail("Invalid device code: ".s)
            fd_devcode = devno
        finish 
    finish  else  start 
        !* must be reroute to a file, "" means "JB#nnnnnn"
        if  s = "" start 
            nfd == record(fdmap(90))
            s = nfd_iden
            s = "JB#".substring(s,8,length(s))
        finish 
        change name(fd,s)
    finish 
end 
endoffile