constinteger  fill blocksize=16000

externalroutinespec  open mag(integer  chan, string (7) tape)
externalroutinespec  write mag(integer  chan, addr, len, integername  flag)
externalroutinespec  writetm mag(integer  chan, integername  flag)
externalroutinespec  rewind mag(integer  chan)
externalroutinespec  unload mag(integer  chan)

externalroutinespec  prompt(string (255) s)
externalintegerfnspec  rdfilead(string (255) s)
externalroutinespec  ucstrg(stringname  s)


externalroutine  write kytape(string (255) s)
integer  flag, j, fad, blocks
string (255) tapename
routinespec  fill rest of tape

   fad=rdfilead("IPLFILE")
   return  if  fad=0

   prompt("To tape-serial number:")
   ucstrg(tapename) until  length(tapename)=6

   open mag(4, tapename."*")
   rewind mag(4)

   blocks=0
   j=fad+32
   while  j<fad+integer(fad) cycle 
      write mag(4, j, 4096, flag)
      if  flag#0 start 
         printstring("Write fails")
         write(flag,1)
         newline
         exit 
      finish 

      blocks=blocks+1
      j=j+4096
   repeat 

   printstring("Initial blocks:"); write(blocks, 1); newline

   writetm mag(4, flag)
   if  flag#0 start 
      printstring("TM fails")
      write(flag, 1); newline
   finish 

   write mag(4, fad, 4096, flag)
   if  flag#0 start 
      printstring("Last block wr fails")

      newline
   finish 

   writetm mag(4, flag)
   writetm mag(4, j)
   if  j#0 or  flag#0 start 
      printstring("Final TM fail")
      write(flag, 1); write(j, 1)
      newline
   finish 

 ! fill rest of tape

   unload mag(4)

routine  fill rest of tape
integer  j, n
   j=fad+32
   for  n=1, 1, 100000 cycle 
      write mag(4, j, fill blocksize, flag)
      if  flag#0 start 
         printstring("Write fails")
         write(flag,1)
         newline
      finish 
   repeat 
end  {fill rest of tape}

end  {write kytape}
endoffile