cmsave.pro 24.8 KB
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680
;+
; NAME:
;   CMSAVE
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Save IDL variables to a file.  (IDL v5 and greater)
;
; CALLING SEQUENCE: (various)
;   CMSAVE, var1, var2, ..., FILENAME=filename [, NAMES=names]
;   CMSAVE, DATA=pointers, NAMES=names, FILENAME=filename
;   CMSAVE, DATA=handles, NAMES=names,  FILENAME=filename
;   CMSAVE, DATA=structure,             FILENAME=filename
;   
; DESCRIPTION: 
;
;   CMSAVE is a replacement for the built-in IDL procedure SAVE, with
;   more flexibility and increased capabilities.
;
;   CMSAVE produces output files that are compatible with the standard
;   save format of IDL versions 4 and 5 (and perhaps greater).
;   Variables may be restored by using either the built-in procedure
;   RESTORE, or CMRESTORE.  The CMSV utility library must be installed
;   in your IDL path to use CMSAVE and CMRESTORE.
;
;   The primary advantages to CMSAVE are the ability to append
;   additional variables to an existing SAVE file, and several
;   flexible ways to pass the data and variable names to be saved.
;   CMSAVE also attempts to run on all IDL versions.
;
;   To append variables to an existing file, simply specify the APPEND
;   keyword, and the filename of an existing writable SAVE file.
;   Variables will be appended to the end of the file.  It is possible
;   to append a variable with the same name as an existing variable in
;   a file.  Both data values are stored in the file.  However the
;   results upon restore are undefined.  There is also a limitation
;   that only one series of heap values -- pointed-to data -- may be
;   saved in a file.
;
;   By the normal convention of the built-in SAVE command, both the
;   data and variable names to be saved are passed as parameters on
;   the command line.  Each parameter must be a named variable; both
;   the name and value are saved.
;
;   This convention may be used in invoking CMSAVE as well.  However,
;   in addition to passing the data by positional parameter, the user
;   can pass the data using the DATA keyword.  If the DATA keyword is
;   used, then an array of pointers or handles may be passed, or a
;   structure of values may be passed.  (see below)  If both are
;   passed, then the positional parameters take precedence.
;
;   It is also possible to explicitly rename the saved variables: the
;   saved name does not need to be the name of the named variable.
;   Use the NAMES keyword to override the default name.  By default
;   the name is drawn from any named variables, or from the structure
;   tag names if the DATA keyword is used with a structure.  The NAMES
;   keyword takes precedence over these values.  NOTE: Values passed
;   by pointer or handle are not named by default, and so will not be
;   saved unless the NAMES keyword is used.
;
; ==================================================================
;   Research Systems, Inc. has issued a separate license intended
;   to resolve any potential conflict between this software and the
;   IDL End User License Agreement. The text of that license
;   can be found in the file LICENSE.RSI, included with this
;   software library.
; ==================================================================
;
; COMPATIBILITY:
;
;   -- File Format --
;   Files written by CMSAVE should be readable with all known versions
;   of IDL at the time of this writing (version 4 - version 5.4).  It
;   is expected that this compatibility will persist.
;
;   CMSAVE cannot write objects, compressed files, or data sets larger
;   than 2 gigabytes.
;
;   Data types available in newer versions of IDL, such as pointers
;   and long integers, will not be readable in older versions of IDL
;   which do not have those data types.
;
;   -- Calling Interface --
;
;   For the most part, all capabilities of CMSAVE are available to the
;   user.  However, it should be noted that passing variables by
;   positional parameter is not available under IDL 4, unless NAMES is
;   used to name the variables explicitly.
;
;   This procedure is part of the CMSVLIB SAVE library for IDL by
;   Craig Markwardt.  You must have the full CMSVLIB core package
;   installed in order for this procedure to function properly.
;
; INPUTS:
;
;   VAR{i} - The variables to be saved.  By default the save name is
;            taken from the named variables that are passed.  These
;            default names can be overridden by using the NAMES
;            keyword.
;
;            Variables can also be specified by passing an array of
;            handles or pointers in the DATA keyword.
;
;            If no variables are passed as positional parameters or
;            using DATA, then CMSAVE will assume that *all* variables
;            at the caller's level should be saved (this is similar
;            behavior to the built-in SAVE routine).  Note that system
;            variables cannot be saved with CMSAVE.
;
; KEYWORDS:
;
;   ALL - for compatibility with the built-in SAVE routine.  Ignored.
;         Note that CMSAVE cannot save system variables.
;
;   FILENAME - the name of the output file.
;              Default: 'cmsave.sav'
;
;   DATA - A list of data elements to be saved to the output file.
;          The data elements can be one of the following.  The means
;          of extracting the data, and the method of naming each
;          variable, are also indicated.
;
;            * An array of pointers to the variables
;                    Data: pointed-to value     Name: from NAMES keyword
;            * An array of handles to the variables
;                    Data: pointed-to value     Name: from NAMES keyword
;            * A 1-element structure containing data to be saved.
;                    Data: tag value            Name: tag name
;
;          Data values are saved one by one, using the appropriate
;          name.  Note that any variables passed as positional
;          parameters will cause the DATA keyword to be ignored.
;
;          The calling routine is responsible for deallocating any
;          pointer or handle resources.
;
;   COMPATIBILITY - a string, which describes the format to be used in
;          the output file.  Possible values are:
;
;                  'IDL4' - format of IDL version 4;
;                  'IDL5' - format of IDL versions 5.0-5.3;
;                  'IDL6' - not supported yet, for versions 5.4-above;
;                  'RIVAL1' - same as 'IDL5', plus a directory entry is
;                            written to the file.
;           Note that files written in IDL5 format may still be
;           readable by IDL v.4.
;           Default: 'IDL5'
;
;   NAMES - a string array, giving the names for each variable.  
;
;           If the data are passed by positional parameters, the names
;           are assigned according to the position of the parameter in
;           the procedure call.  This can be especially useful to
;           rename local variables, and to give names to expressions.
;
;           If the data are passed by an array of pointers or handles,
;           then the names are assigned according to the position of
;           the data in the array.  In this case there is no other way
;           to supply the variable name.  NAMES is required.
;
;           If the data are passed in a structure, then the names are
;           assigned according to the position of the data in the
;           structure.  The NAMES keyword values override the tag
;           names.
;
;   APPEND - if set, then the specified variables are appended to an
;            existing file.  
;
;            Repeated variables will not cause an error, however they
;            may not be restored properly using the built-in RESTORE
;            procedure.  It may also not be permitted to append
;            variables that contain heap pointers, to a save file
;            which already contains heap data.
;
;   STATUS - upon return, an integer indicating the status of the
;            operation.  A value of 1 indicates success, while 0
;            indicates failure.  A failure condition does not
;            necessarily indicate that an individual variable could
;            not be written; use the VARSTATUS keyword to detect such
;            situations.
;
;   VARSTATUS - upon return, an integer array indicating the status of
;               the save operation for each variable.  A value of 1 at
;               position i in the array indicates success for the ith
;               variable, while a value of 0 indicates failure.
;
;   ERRMSG - upon return, a string indicating the status of the
;            operation.  The empty string indicates success, while a
;            non-empty string indicates failure and describes the
;            error condition.
;
;   QUIET - if set, then the error message is returned to the calling
;           routine.  By default an error condition causes execution
;           to stop and the message to be printed on the console.
;
;   VERBOSE - if set, then a short message is printed for each
;             variable.
;
;   XDR - for compatibility with the built-in SAVE routine.  Ignored.
;
; EXAMPLE:
;
;   CMSAVE, VAR1, VAR2, FILENAME='test.sav'
;   CMSAVE, VAR1, VAR2, FILENAME='test.sav', NAMES=['A','B']
;
;     Save the data in VAR1 and VAR2 to the file test.sav.  In the
;     first case the saved variable names will be VAR1 and VAR2.  In
;     the second case the saved variable names will be A and B.
;
;   POINTERS = [ptr_new(VAR1), ptr_new(VAR2)]
;   CMSAVE, DATA=POINTERS, NAMES=['A','B'], FILENAME='test.sav'
;
;     Save the data in VAR1 and VAR2 to the file test.sav.  The saved
;     variable names will be A and B.  Data are passed by pointer.
;
;   STRUCTURE = {A: VAR1, B: VAR2}
;   CMSAVE, DATA=STRUCTURE, FILENAME='test.sav'
;
;     Save the data in VAR1 and VAR2 to the file test.sav.  The saved
;     variable names will be A and B.  Data are passed by structure.
;
; SEE ALSO:
;
;   CMRESTORE, SAVE, RESTORE, CMSVLIB
;
; MODIFICATION HISTORY:
;   Written, 14 May 2000
;   Documented, 22 Sep 2000
;   Made "more" compatible with SAVE; additional documentation, 11 Jan
;     2001, CM
;   Make version checks with correct precision, 19 Jul 2001, CM
;   Added notification about RSI License, 13 May 2002, CM
;
; $Id: cmsave.pro,v 1.16 2009/11/22 23:26:19 craigm Exp $
;
;-
; Copyright (C) 2000-2001, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
function cmsave_handle_value, handle, no_copy=nocop  ;; Utility function
  handle_value, handle, value, no_copy=keyword_set(nocop)
  return, value
end

;; Undocumented
;; MTIMES
;; PASS_METHOD
;; NOCATCH

pro cmsave,   p0,  p1,  p2,  p3,  p4,  p5,  p6,  p7,  p8,  p9, $
             p10, p11, p12, p13, p14, p15, p16, p17, p18, p19, $
             p20, p21, p22, p23, p24, p25, p26, p27, p28, p29, $
             filename=filename0, verbose=verbose, xdr=xdr, $
             compatible=compat0, append=append, all=all, $
             status=status, varstatus=colstatus, mtimes=mtimes, $
             names=names, data=data, pass_method=method, $
             errmsg=errmsg, quiet=quiet, nocatch=nocatch, useunit=useunit, $
             version=revision

  forward_function routine_names, ptr_valid, handle_info

  status = 0
  errmsg = ''
  colstatus = 0 & dummy = temporary(colstatus)  ;; Void out the status

  cmsvlib_version = '<unknown>'
  catch, catcherr
  if catcherr EQ 0 then lib = cmsvlib(/query, version=cmsvlib_version) else lib = 0
  catch, /cancel
  if lib EQ 0 then $
    message, 'ERROR: The CMSVLIB library must be in your IDL path.'

  revision = '$Revision: 1.16 $'
  ;; Extract the version number
  revision = stregex(revision,'\$'+'Revision: *([0-9.]+) *'+'\$',/extract,/sub)
  revision = revision(1)

  if keyword_set(verbose) then begin
     message, /info, 'CMSAVE version '+revision, traceback=0
     message, /info, 'CMSV Library version '+cmsvlib_version(0), traceback=0
  endif

  if NOT keyword_set(nocatch) then on_error, 2

  n_par = n_params()
  ver   = double(!version.release)
  kall  = 0                        ;; NOTE: Ignoring ALL keywod!!
  if n_elements(filename0) EQ 0 then filename0 = 'cmsave.sav'
  filename = strtrim(filename0(0),2)

  if n_elements(compat0) EQ 0 then compat0 = 'IDL5'
  compat = strupcase(strtrim(compat0(0),2))
  lev = routine_names(/level)
  szd = size(data)
  ndata = n_elements(data)
  nnames = n_elements(names)
  
  ;; By default, if no arguments are specified (and no data) then, then
  ;; all of the data in the caller is saved.
  if n_par EQ 0 AND ndata EQ 0 then kall = 1
  if n_par EQ 0 AND kall EQ 0 AND nnames EQ 0 AND ndata EQ 0 then begin
      NO_VARS:
      status = 1
      errmsg = 'WARNING: no variables were specified; '+filename+' not created'
      if NOT keyword_set(quiet) then message, errmsg, /info
      return
  endif

  if kall then begin
      ;; Extract variables from calling procedure
      vlev = lev - 1
      vnames = routine_names(variables=vlev)
      fnames = 'routine_names("'+vnames+'",fetch=vlev)'
      nvar = n_elements(vnames)
      atype = 'FETCH'

  endif else if n_par EQ 0 AND nnames GT 0 then begin
      ;; Extract named variables from the calling procedure
      vlev = lev - 1
      vnames = strtrim(names,2)
      fnames = 'routine_names("'+vnames+'",fetch=vlev)'
      nvar = nnames
      atype = 'FETCH'
      
  endif else if n_par GT 0 then begin
      ;; Extract variables from positional parameters
      vlev = lev
      lev1 = strtrim(lev-1,2)
      nvar = n_par
      fnames = 'p'+strtrim(indgen(nvar),2)
      vnames = strarr(nvar)
      if ver GE 5D then $
        for i = 0L, nvar-1 do $
        dummy = execute('vnames(i) = (routine_names('+fnames(i)+ $
                        ',arg_name='+lev1+'))(0)')
      atype = 'FETCH'

  endif else begin
      ;; Extract variables from DATA
      vlev = lev
      tp = szd(szd(0)+1)
      if tp EQ 10 then begin               ;; POINTER TYPE
          nvar = ndata
          fnames = strarr(nvar) & vnames = fnames
          wh = where(ptr_valid(data) EQ 1, ct)
          if ct GT 0 then fnames(wh) = '*(data['+strtrim(wh,2)+'])'
          atype = 'POINTER'
      endif else if tp EQ 3 then begin     ;; HANDLE TYPE
          nvar = ndata
          fnames = strarr(nvar) & vnames = fnames
          wh = where(handle_info(data) EQ 1, ct)
          if ct GT 0 then $
            fnames(wh) = 'cmsave_handle_value(data('+strtrim(wh,2)+'))'
          atype = 'HANDLE'
      endif else if tp EQ 8 then begin
          nvar = n_tags(data(0))
          stsize = tagsize(data(0), n_tags=nvar, tag_names=vnames)
          fnames = 'data(0).'+vnames
          atype = 'STRUCT'
      endif else begin
          errmsg = 'ERROR: keyword DATA must be a pointer array or structure'
          status = 0
          return
      endelse
  endelse

  if nvar LE 0 then goto, NO_VARS
  colstatus = lonarr(nvar)

  ;; User-renamed variables
  if n_elements(names) GT 0 then begin
      sz = size(names)
      if sz(sz(0)+1) NE 7 then begin
          errmsg = 'ERROR: NAMES must be a string array'
          status = 0
          return
      endif
      vnames(0) = strtrim(strupcase(names(*)),2)
  endif

  ;; Check for variables with missing names.  By default don't do
  ;; anything, unless all the variables do not have names, or if we
  ;; are using IDL 4, which cannot accept parameters from the command
  ;; line.
  wh = where(vnames EQ '', ct)
  if ct EQ nvar then begin
      errmsg = ('ERROR: no variables have names (are you using IDL 4 or' + $
                ' forget the NAMES keyword?)')
      status = 0
      return
  endif
  if ver LT 5D AND ct GT 0 then begin
      if keyword_set(verbose) then $
        message, ('WARNING: in IDL 4 you cannot pass variables by argument '+ $
                  'to CMSAVE.'), /info, traceback=0
  endif

  ;; Collect a summary of pointers
  if ver GE 5D then begin
      cmsv_ptrsum, null, /null
      pheap = null
      pind  = 0L
      
      catcherr = 0
      catch, catcherr
      if catcherr NE 0 then goto, DONE_PTR
      for i = 0L, nvar-1 do begin
          pheap1 = null
          if fnames(i) EQ '' OR $
            execute('cmsv_ptrsum, '+fnames(i)+', pheap1') EQ 0 then $
            goto, DONE_PTR
          if n_elements(pheap1) GT 1 then begin
              pheap = [pheap, pheap1]
              pheap = pheap(uniq(pheap, sort(pheap)))
          endif
          DONE_PTR:
      endfor
      catch, /cancel
  endif else pheap = 0L

  nheap = n_elements(pheap) - 1
  if nheap GT 0 AND compat EQ 'IDL4' then begin
      errmsg = 'ERROR: cannot store pointer data in IDL4 version file'
      status = 0
      return
  endif

  ;; Open output file
  if keyword_set(append) then access='RW' else access='W'
  cmsv_open, unit, filename, off0, access=access, /get_lun, status=status, $
    errmsg=errmsg, compat=compat
  if status EQ 0 then begin
      if keyword_set(quiet) EQ 0 then message, errmsg, traceback=0
      return
  endif
  pp = 0L

  has_heap = 0
  nauxvars = 0L
  if keyword_set(append) then begin
      ;; Scan through input file until we reach the end-of-file block
      bn = ''
      while status EQ 1 AND bn NE 'END_MARKER' do begin
          point_lun, unit, off0
          block = 0 & dummy = temporary(block)
          cmsv_rrec, block, pp, unit=unit, next_block=pnext, /init, $
            block_type=bt, block_name=bn, status=status, errmsg=errmsg, $
            promote64=promote64
          if status EQ 0 then goto, CLEANUP
          if bn EQ 'HEAP_INDEX' then has_heap = 1
          if bn EQ 'VARIABLE' AND status EQ 1 then begin
              cmsv_rvtype, block, pp, vn, sz1, unit=unit, status=st1, $
                template=tp1, errmsg=err1
              if strmid(vn,0,12) EQ '_CMSAVE_DIR_' then $
                nauxvars = nauxvars + 1
          endif
          if status EQ 1 AND bn NE 'END_MARKER' then off0 = pnext
      endwhile

      if bn NE 'END_MARKER' then goto, CLEANUP
      point_lun, unit, off0
      
  endif else begin
      ;; Create the file and append the start record blocks
      if keyword_set(verbose) then $
        message, 'Portable (XDR) SAVE/RESTORE file.', /info

      ;; both timestamp and version information
      cmsv_wrec, block, pp, block_name='TIMESTAMP', offset=off0, $
        status=status, errmsg=errmsg
      if (status NE 0) AND (compat NE 'IDL4') then $
        cmsv_wrec, block, pp, block_name='VERSION', offset=off0, $
        status=status, errmsg=errmsg, compat=compat
      if (status EQ 0) OR (pp EQ 0) then goto, CLEANUP

      writeu, unit, block(0:pp-1)
      off0 = off0 + pp
  endelse

  if nheap GT 0 AND keyword_set(append) AND has_heap AND $
    strmid(compat,0,3) EQ 'IDL' then begin
      errmsg = 'ERROR: cannot APPEND data containing POINTER type'
      goto, CLEANUP
  endif

  pp = 0L
  block = 0 & dummy = temporary(block)

  if nheap GT 0 then begin
      pind = lindgen(nheap) + 1
      pheap = pheap(1:nheap)
      cmsv_wrec, block, pp, pind, block_name='HEAP_INDEX', offset=off0, $
        status=status, errmsg=errmsg, unit=unit1
      if status NE 1 then goto, CLEANUP
  endif 
  if pp GT 0 then writeu, unit, block(0:pp-1)
  off0 = off0 + pp

  if keyword_set(useunit) then $
    unit1 = unit

  pp = 0L
  block = 0 & dummy = temporary(block)
  init = 1 & err1 = '' & saved = 0
  erri = strarr(nvar+nheap)

  catcherr = 0 & caught = 0
  if NOT keyword_set(nocatch) then catch, catcherr
  if catcherr NE 0 then begin
      caught = caught + 1
      goto, DONE_VAR
  endif

  for i = 0L, nheap+nvar-1 do begin
      saved = 0
      nelem = 0
      j = i - nheap

      if j LT 0 then begin
          ;; Extract heap value
          bn = 'HEAP_DATA'
          vname = long(pind(i))
          dummy = execute('sz = size(*pheap(i))')
          if sz(sz(0)+1) EQ 0 then goto, DONE_VAR
          dummy = execute('var = *pheap(i)')

      endif else begin
          ;; Extract variable value
          bn = 'VARIABLE'
          fname = fnames(j)
          vname = vnames(j)
          
          sz = 0 & var = 0 & dummy = temporary(var)
          if fname EQ '' then begin
              NO_NAME:
              err1 = 'WARNING: un-named expression(s) not written'
              goto, DONE_VAR
          endif

          if execute('sz = size('+fname+')') EQ 0 then goto, DONE_VAR
          if sz(sz(0)+1) EQ 0 OR sz(sz(0)+2) EQ 0 then goto, DONE_VAR
          if execute('var = '+fname) EQ 0         then goto, DONE_VAR

          ;; For data taken from the structure then we may need to
          ;; pull out a more accurate array type.
          if atype EQ 'STRUCT' then sz = stsize(*,j)
          sz = sz(0:sz(0)+2)
          
          nelem = n_elements(var)
          if nelem EQ 0  then goto, DONE_VAR
          if vname EQ '' then goto, DONE_VAR
      endelse

      ;; Stupid dimensions can be reformed just by assignment.  This
      ;; will catch and reform the variable.
      if (sz(0) GT 0) AND (n_elements(size(var)) NE n_elements(sz)) then $
        var = reform([var], sz(1:sz(0)), /overwrite)
      sz = size(var)
 
      ;; Write data to a block in memory
      off1 = pp
      cmsv_wrec, block, pp, var, vname, block_name=bn, offset=off0, $
        ptr_index=pind, ptr_data=pheap, init=init, unit=unit1, $
        status=status, errmsg=errmsg
      init = 0
      if status EQ 0 then goto, CLEANUP
      saved = 1

      DONE_VAR:
      ;; A tricky business, this error catching...
      if caught GT 1 then begin
          errmsg = 'ERROR: an internal error occurred'
          goto, CLEANUP
      endif
      if caught GT 0 then begin
          err1 = errmsg
      endif

      ;; If we have accumulated enough data, write to file
      if (pp GT 32768L) OR ((i EQ nheap+nvar-1) AND pp GT 0) then begin
          writeu, unit, block(0:pp-1)
          block = 0 & dummy = temporary(block)
          init = 1
          off0 = off0 + pp
          pp = 0L
      endif
      if keyword_set(useunit) AND pp EQ 0 then $
        point_lun, -unit, off0

      ;; Print some diagnostic messages
      if j GE 0 then begin
          colstatus(j) = saved
          if keyword_set(verbose) AND saved then $
            erri(i) = 'Saved variable: '+vname+'.'
          if saved EQ 0 then begin
              if err1 NE '' then $
                erri(i) = err1 $
              else if nelem EQ 0 then $
                erri(i) = 'Undefined item not saved: '+vnames(j)+'.' $
              else begin
                  erri(i) = ('Expression must be named variable: <'+$
                             helpform('', var, /short)+'>')
                  if ver LT 5D then $
                    erri(i) = erri(i) + ' - use NAMES keyword under IDL4'
              endelse
          endif
      endif else begin
          if keyword_set(verbose) AND saved then $
            erri(i) = ('Saved heap value: <'+ $
                       helpform('', var, /short)+'>')
      endelse

      caught = 0
  endfor
  catch, /cancel
  wh = where(erri NE '', ct)
  if ct GT 0 then begin
      if NOT keyword_set(quiet) then for i = 0L, ct-1 do $
        message, erri(wh(i)), /info
      fmt = '('+strtrim(ct,2)+'(A,:))'
      if ct GT 1 then erri(wh(1:*)) = erri(wh(1:*)) + ';'
      errmsg = string(erri(wh), format=fmt)
  endif

  if pp GT 0 then writeu, unit, (temporary(block))(0:pp-1)
  off0 = off0 + pp

  pp = 0L & off1 = 0L
  ;; Write a set of auxiliary directory information
  whgood = where(colstatus NE 0, ngoodvars)
  if ngoodvars GT 0 AND strmid(compat,0,5) EQ 'RIVAL' then begin
      ;; Construct a unique name for the auxiliary directory
      nauxvars = nauxvars + 1
      fname = filename
      i = (rstrpos(fname,'/') > rstrpos(fname,'\') > rstrpos(fname,':') > $
           rstrpos(fname,';') > 0L)
      fname = byte(strmid(fname, i, strlen(fname)))
      i = strpos(fname, '.')
      if i GT 0 then fname = strupcase(strmid(fname, 0, i))
      bb = byte(fname)
      wh = where(bb LT (byte('A'))(0) OR bb GT (byte('Z'))(0), ct)
      if ct GT 0 then bb(wh) = 32b
      fname = strcompress(string(bb), /remove_all)
      if strlen(fname) EQ 0 then fname = 'FILE'
      
      ;; Whew, we got a name!  Now create the data for the directory
      auxvname = string(fname,nauxvars, $
                        format='("_CMSAVE_DIR_",A0,"_",I2.2)')
      auxvdata = replicate({variable:'', mtime:systime(1)}, ngoodvars)
      auxvdata.variable = vnames(whgood)
      if n_elements(mtimes) GT 0 then $
        auxvdata.mtime(0) = double(mtimes(whgood(0:n_elements(mtimes)-1)))
      auxsz = size(auxvdata)

      ;; Write out directory data
      cmsv_wrec, block, pp, auxvdata, auxvname, block_name='VARIABLE', $
        offset=off0, status=status, errmsg=errmsg, unit=unit1
  endif
  ;; Write end marker
  cmsv_wrec, block, pp, block_name='END_MARKER', status=status, offset=off0
  if status EQ 1 AND pp GT 0 then writeu, unit, block(0:pp-1)
  free_lun, unit
  return

  ;; 
  ;; Error handling routine, outside the normal call flow
  CLEANUP:
  catch, /cancel
  free_lun, unit
  status = 0
  if errmsg NE '' AND NOT keyword_set(quiet) then message, errmsg, /info

  return
end