%EXTERNALROUTINE WSLD %alias "C#WSLD"
%EXTERNALROUTINESPEC OPENMAG %alias "S#OPENMAG"(%INTEGER CHAN, %STRING (7) VOL)
%EXTERNALROUTINESPEC SKIPMAG %alias "S#SKIPMAG"(%INTEGER CHAN,BLOCKS)
%EXTERNALROUTINESPEC WRITEMAG %alias "S#WRITEMAG"(%INTEGER CHAN,AD,LEN, %INTEGERNAME FLAG)
%EXTERNALROUTINESPEC WRITETMMAG %alias "S#WRITETMMAG"(%INTEGER CHAN, %INTEGERNAME FLAG)
%EXTERNALROUTINESPEC UNLOADMAG %alias "S#UNLOADMAG"(%INTEGER CHAN)
%EXTERNALINTEGERFNSPEC RDFILEAD(%STRING (255) FILE)
%EXTERNALROUTINESPEC MOVE %ALIAS "S#MOVE"(%INTEGER LENGTH,FROM,TO)
%externalroutinespec emas3string(%stringname vector,param)
%externalroutinespec set return code %alias"emas3setreturncode"(%integername value)
%OWNINTEGERARRAY IPL REC(0:5)= %C
      x'00080000',x'00001008',          { PSW }
      x'02001000',x'60001000',          { CCW block to x1000 }
      x'08001000',x'00000000'           { TIC to x1000 }
%CONSTINTEGER SLDLEN=1024
%OWNINTEGERARRAY SLD(1:SLDLEN)= %C
      x'3f000000',x'20000001',          { skip over TM }
      0(*)                              { sld code }
%string(63) tape,file
%INTEGER I,FLAG,CONAD
      emas3string("tape name;any,uc,despce;?;THe tape to become a dump tape;;",
       tape)
      emas3string("IPL program;file;ercc07:sldxay;IPL program name;",file)
      CONAD=RDFILEAD(file)
      %RETURNIF CONAD<=0
      %UNLESS LENGTH(TAPE)=6 %THEN PRINTSTRING("Tape??") %ANDRETURN
      OPENMAG(1,TAPE."*")
      SKIPMAG(1,1);                     ! over VOL1 label
      WRITEMAG(1,ADDR(IPL REC(0)),24,FLAG)
      ->FAIL %UNLESS FLAG=0
      MOVE(SLDLEN*4-8-INTEGER(CONAD+4),CONAD+INTEGER(CONAD+4),ADDR(SLD(3)))
      WRITEMAG(1,ADDR(SLD(1)),SLDLEN*4,FLAG)
      ->FAIL %UNLESS FLAG=0
      WRITETMMAG(1,FLAG)
      ->FAIL %UNLESS FLAG=0
      WRITETMMAG(1,FLAG)
      UNLOADMAG(1)
      PRINTSTRING("IBM/SLD tape written ok
")
     
      set return code(flag)
%RETURN
FAIL:
      PRINTSTRING("Write SLD tape fails.....")
      %MONITOR

      set return code(flag)
%END
%ENDOFFILE