$ on warning then exit
$ debug = 0
$! debug = 1                    ! *** COMMENT AFTER TESTING ***
$ open/read dmp &p1
$ bct = 0
$ fsp :=
$read_loop_1:
$ read/end=eof_dmp dmp p9
$! if debug then write sys$output p9
$ if f$extr( 0, 12, p9 ) .eqs. "Dump of file" then -
$ fsp = f$elem( 3, " ", p9 )
$ if fsp .eqs. "" then goto read_loop_1
$ on warning then goto err_exit
$ gosub open_img_file
$ bufr = f$fao( "!512* " )
$ cntr = 128
$ gosub init_img_block
$read_loop_2:
$ read/end=eof_dmp dmp p9
$! if debug then write sys$output p9
$ if f$extr( 0, 13, p9 ) .nes. "Virtual block" then -
$ goto read_loop_2
$ read/end=eof_dmp dmp p9               ! s/b blank line
$! if debug then write sys$output p9
$ read/end=eof_dmp dmp p9               ! s/b 1st line of dump
$! if debug then write sys$output p9
$ if    f$length( p9 ) .le. 80
$ then
$       wpl = 4
$       lpb = 32
$ else
$       wpl = 8
$       lpb = 16
$ endif
$! if debug then -
$! WRITE SYS$OUTPUT -
$!      F$FAO( " Words per line = !UL, lines per block = !UL", wpl, lpb )
$ lct = 0
$read_loop_3:
$ lct = lct + 1
$ gosub extract_lwords
$ read/end=eof_dmp dmp p9
$! if debug then write sys$output p9
$ if lct .lt. lpb then -
$ goto read_loop_3
$ goto read_loop_2
$!
$eof_dmp:
$ write sys$output " ''FSP' successfully recreated."
$err_exit:
$ close dmp
$ close img
$ exit
$!
$extract_lwords:
$ pntr = 0
$el_elem_loop:
$ pntr = pntr + 1
$ elem = f$elem( pntr, " ", p9 )
$ lwd = "    "
$ lwd[0,32]=%X'elem'
$ byt = (((lct - 1) * wpl ) + (wpl - pntr)) * 4
$ if debug then -
$ show symbol byt
$ stb = byt * 8
$ if debug then -
$ show symbol stb
$! bufr['stb',4]:="''lwd'"
$ bufr['stb',32]=%X'elem'
$ cntr = cntr + 1
$ if cntr .eq. 128 then gosub write_img_block
$ if pntr .lt. wpl then goto el_elem_loop
$ return
$!
$write_img_block:
$ bct = bct + 1
$! if debug then -
$ write sys$output f$fao( " Writing block !UL of !AS", bct, fsp )
$ if debug then write sys$output f$length( bufr )
$ write/symbol img bufr
$init_img_block:
$iib_loop:
$ stb = (cntr - 1) * 4 * 8
$ bufr['stb',32]=0
$ cntr = cntr - 1
$ if cntr .ne. 0 then -
$ goto iib_loop
$ return
$!
$open_img_file:
$ fnm = f$parse( fsp,,, "name", "syntax_only" )
$ fxt = f$parse( fsp,,, "type", "syntax_only" )
$ fsp = fnm + fxt
$ copy/nolog/noconfirm nla0: &fsp
$ set file/attr=(rfm=fix,lrl=512) &fsp
$ open/append img &fsp
$ return