%constant %integer true=0,false=1
%constant %integer testing=false
%if testing = true %start
   %routine %spec monitor(%string (255) s)
%finish
%system %string %function %spec failuremessage(%integer flag)
%system %string (31) %function %spec itos(%integer i)
%own %string (11) save owner,save file
%own %integer already connected=0
%constant %string (6) %name me=9<<18
%system %routine %spec outfile(%string (31) file, %integer size,hole,prot,
    %integer %name conad,flag)
%system %routine %spec move(%integer len,from,to)
%system %routine %spec destroy(%string (31) file, %integer %name flag)
%system %string (31) %function %spec nexttemp
%system %routine %spec setpar(%string (255) par)
%system %integer %function %spec parmap
%system %string (31) %function %spec spar(%integer which)
%system %integer %function %spec allowconnect(%string (6) who,
    %string (11) what)
%system %routine %spec zcopy2(%string (255) par, %integer silent,
    %integer %name flag)
%record %format hf(%integer dataend,datastart,size,filetype)
%record %format rf(%integer conad,filetype,datastart,dataend)
%system %routine %spec connect(%string (31) file, %integer mode,hole,prot,
    %record (rf) %name r, %integer %name flag)
%external %integer %function %spec dconnect(%string (6) owner,
    %string (11) file, %integer fsys,mode,apf, %integer %name seg,gap)
%external %integer %function %spec ddisconnect(%string (6) owner,
    %string (11) file, %integer fsys,destroy)
%routine bconnect(%string (31) full file, %integer mode,hole,prot,
    %record (rf) %name r, %integer %name flag)
   %record (hf) %name h
   %string (6) owner
   %string (31) file,partition
   %integer seg,gap,fsys,apf,conad
   %if full file -  > owner.(".").file %start
   %finish %else %start
      owner = me
      file = full file
   %finish
   %if file -  > file.("_").partition %then %start
   %finish %else %start
      partition = ""
   %finish
   mode = 1
   fsys = -1
   apf = 0
   seg = 0
   gap = 0
   save owner = owner
   save file = file
   flag = dconnect(owner,file,fsys,mode,apf,seg,gap)
   %if flag = 34 %then flag = 0 %and already connected = true %else %c
      already connected = false
   %if flag # 0 %then flag = flag + 500 %and %return
   conad = seg << 18
   h == record(conad)
   r_conad = conad
!h==record(seg<<18)
!r_conad=addr(h)
!r_conad=seg<<18
   r_filetype = h_filetype
   r_datastart = h_datastart
   r_dataend = h_dataend
%end
%routine bdisconnect
   %integer flag
   %unless already connected = true %then %c
      flag = ddisconnect(save owner,save file,-1,0)
%end
%routine copy inner(%string (31) file, %string (31) %name new,
    %integer %name flag)
   %integer oldconad,newconad,oldlen,dummy
   %record (rf) r1
   %if testing = true %start
      monitor("about to call bconnect:".file.",0,0,0,r1,flag")
   %finish
   bconnect(file,0,0,0,r1,flag)
   %if flag # 0 %then %return
   oldconad = r1_conad
   oldlen = r1_dataend
   new = "T#".nexttemp
   %if testing = true %start
      monitor("about to call outfile:".new.",".itos(oldlen).",".itos(oldlen). %c
         ",newconad,flag")
   %finish
   outfile(new,oldlen,oldlen,0,newconad,flag)
   %if flag # 0 %then %return
   %if testing = true %start
      monitor("about to call move:".itos(oldlen).",".itos(oldconad).",".itos %c
         (newconad))
   %finish
   move(oldlen,oldconad,newconad)
   bdisconnect
%end

%external %routine copy3(%string (255) par)
   %string (31) old file,new file,owner,file,temp,member,save old file
   %integer flag,temp created,dummy
   setpar(par)
   %if parmap # 3 %then flag = 263 %and ->fail
   oldfile <- spar(1)
   newfile <- spar(2)
   save old file = oldfile
   %if testing = true %start
      monitor("copy3:".oldfile.",".newfile)
   %finish
   %unless oldfile -  > owner.(".").file %then owner = me %and file = old file
   %unless file -  > file.("_").member %then member = ""
   length(owner) = 6 %if length(owner) > 6
   length(file) = 11 %if length(file) > 11
   %if testing = true %start
      monitor("about to call allowconnect:".owner.",".file)
   %finish
   %if owner # me %and allowconnect(owner,file) # 0 %then %start
!   %if allowconnect(owner,file) # 0 %or owner=me %start
      %if testing = true %start
         monitor("Allowconnect failed")
         monitor("about to call Copy Inner:".owner.".".file.",temp")
      %finish
      copy inner(owner.".".file,temp,flag)
      ->fail %if flag # 0
      file = temp
      temp created = true
      %if testing = true %start
         monitor("TEMP=".temp)
      %finish
      oldfile = me.".".temp
   %finish %else %start
      tempcreated = false
      oldfile = owner.".".file
   %finish
   %if member # "" %then oldfile = oldfile."_".member
   %if testing = true %start
      monitor("About to call zcopy2:".oldfile.",".newfile."/W,1,flag")
   %finish
   zcopy2(oldfile.",".newfile."/W",1,flag)
fail:
   %if flag = 0 %start
      %if testing = true %start
         newline
      %finish
      printstring(spar(2)." is a copy of ".save old file)
      newline
      %if temp created = true %then destroy(temp,dummy)
   %finish %else %start
      %if testing = true %start
         monitor("Flag=".itos(flag)."  sorry!")
      %finish
      printstring("Copy3 fails  - ".failuremessage(flag))
      newline
   %finish
%end
%if testing = true %start
   %routine monitor(%string (255) s)
      newline
      printstring("*** ".s)
!   newline
   %end
%finish
%end %of %file