[Date Prev] [Date Next] [Thread Prev] [Thread Next] Date Index Thread Index Search archive:
Date:Mon Jun 15 18:12:49 1994 
Subject:Saving and Restoring Data - The Code at Last. 
From: Robin Popplestone  
Volume-ID:940616.01 

These facilities have had a fair amount of testing. The commenting of the
code is a bit screwed up (sorry) by the latest extensions which have made
the utility much more versatile.

Comments please

Robin.

==============================================================================

HELP restore_data, save_data               Robin Popplestone MAR 1994

This file may be freely copied and modified, provided the above attribution
is preserved or amended appropriately.

The procedure -save_data- visits  each node of  a Poplog datastructure.  By
default it creates a "saved  form" of the structure  on disc, which can  be
read in by -restore_data-.

The user can adapt -save_data- in many versatile ways by supplying her  own
versions of various procedures,  effectively providing a general  structure
mapping capability. For example, an array which indexes a structure can  be
generated, and it is even possible to generate C programs which "replicate"
a given POP structure.

This text may be freely copied provided the above attribution is preserved.

         CONTENTS - (Use <ENTER> g to access required sections)

 --  How to use these facilities to save data to backing store and restore it.
 --  The format of the saved data
 --  An Example - saving a circular list.
 --  Limitations - no saving of widgets, external data and some procedures
 --  But class_save class_restore class_update mitigate the limitations.
 --    Writing the -save- procedure
 --    Writing the -restore- and -update- procedures
 --      stack_fields(Rep,m) reads and stacks fields ending with ";"
 --      restore_field(Rep,m) reads a single field
 --  User definition of the saved format using a property as second argument
 --      The "before" property entry specifies how to sort the indices.
 --      The "class_save" entry supports data-class specific output.
 --      The "new_index" entry generates an index for a Poplog structure.
 --      The "save_field" entry specifies how to save a field
 --      The "save_struct" entry specifies how to save a whole structure.
 --      The "pr_header" entry is called initally to put out a header.
 --      The "pr_string" entry can save a string in the desired format.
 --      "pr_trailer" is called finally. It may close the output file
 --      The "FileSpec" entry specifies where the output is to go.
 --      An example - making an array that indexes a structure.
 --  restore_data provides more capabilities than datafile
 --  Use with lib objectclass

How to use these facilities to save data to backing store and restore it.
-------------------------------------------------------------------------
save_data allows many Pop data structures, including "circular" structures,
to be recorded on backing store, and  to be read back. It thus extends  the
scope of LIB * DATAFILE. To write a structure to backing store type:

    save_data(<struct>, <filename>) -> <property>;

The meaning  of  the  <property>  is explained  in  the  section  on  "User
definition of the saved format". For  simple uses of -save_data- it can  be
ignored.

Similarly, to read a structure back from backing store, type:

    restore_data(<filename>) -> <struct>;

the (default) permitted datatypes are:

    words, numbers, lists, vector types, record types,
    vector arrays, ordinary properties, booleans and closures

A named procedure  can be  "saved"; what  this means  is that  its name  is
written to the file on saving.  On restoration the procedure with the  same
(global) name is restored, using valof.  save_data checks that the name  of
the procedure in its -pdprops- is  associated with the procedure itself  as
value.

A similar approach is  adopted for -key- objects.  The dataword is  written
and the corresponding key is regenerated.

The format of the saved data
-----------------------------
The whole saved file is described by the syntax:

    <saved_file> -> SavedData <version> <date> <field> <objects>
    <version> -> V1

Here the <version> specifies  which version of save_data  was used to  save
the data. If  the file does  not begin with  SavedData, the older  datafile
capability is assumed to have been used.

<date> is a string, derived from sysdaytime, and records the actual time of
writing of the file.

A <field> is a specification of a  POP item (record, vector etc.) which  is
either self-contained or is the index referring to a line in the file where
the item actually "is",  i.e. a kind of  in-file pointer. Simple items  and
certain compound items are self-contained.

    <field> ->  (<index>)     Pointer to the item in line labelled <index>
            ->  "<string>"    The word made from the string.
            ->  <string>      A POP-11 string.
            ->  <word>        A POP-11 variable - take the valof.

The <word> option is used for named procedures and certain system constants
(e.g. false).

In the <saved_file> syntax, the <field> specifies the actual item that  has
been saved. This  distinguishes it from  its sub-items, since  it will  not
necessarily have any particular index. A simple item will have no <objects>
following it. Thus the number 654 is saved as:

SavedData V1
'Wed Jun 15 13:48:25 EDT 1994'
654

However, normally we have <objects>

    <objects> -> <object> <objects>
              -> <null>

where <null> is the grammar which generates just the null sequence.

    <object> -> <index> <dataword> <fields> ;
                -> <index> %a <array>
                -> <index> %c <closure>
                -> <index> %p <property>

An array is written out as specified by the following syntax. Here the  two
<int> values are the arrayvector_bounds of the array. No updater is written
as it is illegal to change the updater of an array.

    <array> -> <boundslist> <vector> <subscr> <int> <int> <byrow> <props>
    <boundslist> -> [ <int> <int> .... ]
    <vector> -> <field>         ;;; The vector of values
    <subscr> -> <field>         ;;; Subscripting procedure
    <byrow> -> true | false     ;;; storage by row?
    <props> -> <field>          ;;; The pdprops


A closure is written out as:

    <closure> -> <pdpart> <pdprops> <updater>

Here all three components are written out as fields.

A property is written out as:

    <property> -> <alist> <size> <default> <props> <updater>
    <alist> -> <field>          ;;; The association list of the property
    <size>  -> <int>            ;;; The size of the hash table
    <default> -> <field>        ;;; the value to be returned by default
    <props>   -> <field>        ;;; The -pdprops- field of the property.
    <updater> -> <field>        ;;; The -updater- of the property.
                                ;;; This is -false- if the standard updater
                                ;;; is in use.

An Example - saving a circular list.
-----------------------------------
The circular list created by:

    vars circular = [44 fred 'ab' [55 66] last];
    circular -> circular.tl.tl.tl.tl.tl;
    save_data(circular,'circ.tmp') ->;

creates the following file:



SavedData V1
'Wed Jun 15 13:46:43 EDT 1994'
(1)
1 pair 44 (2);
2 pair "'fred'"(3);
3 pair 'ab'(4);
4 pair (5)(6);
5 pair 55 (7);
6 pair "'last'"(1);
7 pair 66 nil ;

Limitations - no saving of widgets, external data and some procedures
---------------------------------------------------------------------
Apart from the inability to save anonymous procedures, widgets and external
data, there are other limitations.

(1) This  facility  only  handles  properties  that  can  be  created  with
-newproperty- and assumes that any properties are -permanent-.

(2) Properties  which  are  circular  in  the  sense  that  they  associate
themselves with some other data, for example P below:

     P -> P(key)

must NOT be saved -  an infinite loop will  result. It is anticipated  that
this will occur rather seldom.  Content-hashed properties are not  restored
correctly.

(3) Apart from arrays and properties, no procedure is -truly- saved,  since
its name only  is written.  This is  probably the  most useful  capability,
since, provided there is no change in the specification of procedures, data
should be reusable with a new version of a program.

(4) The updater of properties is not saved.

But class_save class_restore class_update mitigate the limitations.
-------------------------------------------------------------------
Where a structure may contain sub-structures which may not be saved by  the
default -save_data-  procedure, for  example because  it contains  external
data, or widgets, or  anonymous procedures, or  if it contains  information
that it is not necessary to save, such as a big image taken from a library,
then then user can define her own  "methods" using an analog of the  simple
built in  class_...  procedures,  which  work  in  a  manner  analogous  to
class_print (see ref print).

For any  data  class,  with  data-key  Key,  which  is  to  be  saved  by a
user-defined procedure, write a procedure P_save (say) to save, members  of
that class, a procedure P_restore to restore class-members and a  procedure
P_update  to  update   members  as  described   below.  Then,  making   the
assignments:

section $-SAVE_DATA;
   ...... code for P_save etc. (don't forget to import anything you need into
   ......       the section)
    P_save -> class_save(Key);
    P_restore -> class_restore(Key);
    P_update  -> class_update(Key);
endsection;

will ensure that members of that class can be saved and restored.

  Writing the -save- procedure
------------------------------
This procedure should write out enough components of the data-structure  to
allow it to be  restored by the user-written  restore procedure. Layout  is
not prescribed, but compound components will normally be written using  the
-save_field- procedure. This will typically write just an index number  for
a  compound  component,  as  described  in  the  -format-  section   below.
-save_field- must be used if there  is any possibility of circularity.  The
-dataword- will be written out -before- the -save- procedure is called, and
a semicolon will be written after.

IMPORTANT when the -restore- and -update- procedures are called, you cannot
assume that  any  data-structure  is  properly  built  yet.  The  -restore-
procedure  actually  constructs   -your-  data-structure,   but  does   not
necessarily put in the actual final values in its components. The  -update-
procedure puts in the pointers to the correct structures, but these may not
have been updated. Therefore you -cannot-  rely on any information that  is
normally in a data-structure  actually being there.  In the example  below,
while the widget can be reconstructed  from the size of picture (Pic)  that
it is to hold,  we cannot assume that  -contents_Image- will evaluate  to a
picture at any time during the restoration process (except of course at the
end, but we have to act before the end).

An example:

define save_Image(Im);                         ;;; Save an Image, Im
  lvars W = Widget_Image(Im);                  ;;; If it is displayed in a
  if W then true endif -> Widget_Image(Im);    ;;; widget, replace by <true>
  lvars Pic = contents_Image(Im);              ;;; Get size of picture
  lvars (dx,dy) = (dx_Pic(Pic),dy_Pic(Pic));
  appdata(Im,save_field);                      ;;; save fields of Im record
  spr(";"); spr(dx); spr(dy);                  ;;; save size of picture
  W -> Widget_Image(Im);                       ;;; restore widget
enddefine;


  Writing the -restore- and -update- procedures
-----------------------------------------------
These both read  data written  by the corresponding  -save- procedure.  The
save file is  scanned twice.  In the  first scan  -restore- procedures  are
called to build the data-structures,  in the second forward references  are
updated.

The -restore- function is called with parameters

  restore(Rep,m)

It should return the  restored data-structure which it  has read using  the
item-repeater Rep. The  parameter -m-  is passed on  to the  -stack_fields-
procedure described below.  It is the  serial number of  the latest  record
actually constructed on restore. On update it is very big.

    stack_fields(Rep,m) reads and stacks fields ending with ";"
----------------------------------------------------------------
The SAVE_DATA section contains a procedure -stack_fields- which will  stack
up fields which it reads until a semicolon is encountered, putting a  count
on the stack.

    stack_fields(Rep,m) -> Fld_1 ..... Fld_n, n

The procedure -restore_field- is available to read individual components.

    restore_field(Rep,m) reads a single field
---------------------------------------------
Here Rep is the item-repeater  for the file. m is  the index of the  latest
record formed. Any reference to a file-record preceding m can be finalised.
Forward references have to be postponed. restore_field(Rep,m) -> (Obj,flag)

If the flag = termin then we have read the last field in the object.
If the flag = true then Obj is an integer index to a forward reference
If the flag = false then Obj is the actual finalised POP-11 object


Thus the -restore- procedure will normally read and stack components
of the structure and then call the class-constructor. An example:

define restore_Image(Rep,m);
  consImage((stack_fields(Rep,m)->;));     ;;; Build the actual structure
  stack_fields(Rep,m) -> ; -> ; -> ;       ;;; ignore the Widget info
enddefine;

restore_Image -> class_restore(Image_key);

The update procedure is called with 3 parameters, namely
 (a) Your own item which is being restored
 (b) The item repeater made from the saved data
 (c) A parameter -m- which is given to -stack_fields- etc.
It should read the fields off the repeater in the same way as the restore
procedure, but use these fields to update the corresponding fields in
the object itself (-fill- is often a useful way of doing this, see
HELP *FILL).

An example is given below.

define update_Image(Im,Rep,m);             ;;; We read the fields and use
  fill((stack_fields(Rep,m)->),Im)->;      ;;; them to update the structure.
  lvars (dx,dy,_) = stack_fields(Rep,m);   ;;; Read the dimensions of widget
  lvars is_W = Widget_Image(Im);           ;;; If there should be a widget
  if is_W then
  lvars W_new = mk_GraphicWidget('dx'><"*"><'dy',   ;;; make one to spec
                                 dx,dy,false,
                                 CB_button_Lv);
  endif;                                            ;;; and put it in its
  W_new -> Widget_Image(Im);                        ;;; slot.
enddefine;

User definition of the saved format using a property as second argument
-----------------------------------------------------------------------
The second argument of -save_data-  may be a property.  In that case it  is
used to  provide  user-defined  versions  of  various  procedures  used  by
save_data. This allows a  much more radical redefinition  of the action  of
-save_data- than  the  class_save  capability defined  above.  For  example
-save_data- can be  used (in several  passes) to create  a C program  which
will recreate a POP data-structure.

The concept of "index" can be generalised to include any Poplog object  for
which an  ordering relation  is defined.  Thus,  if a  C program  is  being
generated, indices will be C-identifiers which will be bound to the objects
being recreated.

The POP-11 call:

    save_data(<struct>, <property>) -> <property>

returns a property which maps from the sub-structures of <struct> to  their
indices. This property is important  if consistency of mapping is  required
over repeated calls of -save_data-.

    The "before" property entry specifies how to sort the indices.
------------------------------------------------------------------
This should be a binary  ordering predicate, such as  nonop <= which is  in
fact  the  default  value.  Use  -alphabefore-  if  you  are  dealing  with
identifiers as indices.

    The "class_save" entry supports data-class specific output.
---------------------------------------------------------------
In case -save_data- is  needed with class_save  entries that are  different
for different calls of -save_data-, we provide this -class_save- entry.  It
is not  expected that  many people  will need  this, because  more  radical
changes are to be expected, using the "save_struct" entry, below.

    The "new_index" entry generates an index for a Poplog structure.
-----------------------------------------------------------------
new_index(Struct) must  produce  a  unique  new  index  for  the  structure
-Struct-.  The  default  value  of  -new_index-  produces  integer  indices
starting at 1.

For example, the following generates a  new index based on the dataword  of
the structure

    define new_c_index(Struct);
      gensym(dataword(Struct));
    enddefine;

E.g. new_c_index([2 3]) may return "pair234".

Note: if save_data is called multiple  times and consistent use of  indices
is required, you will probably need to incorporate the property returned by
-save_data- in -new_index-, so that -new_index- returns the index  assigned
by a previous pass.

For example:

    define new_index_P(Struct);
        P_index(Struct);
    enddefine;

Using the property returned by a first pass:

    save_data(Struct,spec_declare) -> P_index;

We create a new property:

    lvars spec_assign = newassoc([ [new_index   ^new_index_P]])

And call a second pass of -save_data-

    save_data(Struct,spec_assign)->;

Deliberately, there is no facility  whereby the property returned from  one
call from save_data can  be reused -directly- in  a second call, since  the
existence of an entry in the  property is taken by -save_data- as  evidence
that a given structure has been fully saved.

    The "save_field" entry specifies how to save a field
--------------------------------------------------------
The save_field procedure, specified above, can be redefined. Typically more
radical  modifications  of   the  output  of   -save_data-  will  use   the
"save_struct" entry below.

    The "save_struct" entry specifies how to save a whole structure.
--------------------------------------------------------------------
This procedure is usually  the most complex one  to write for any  advanced
use of save_data. Typically,  -save_struct(Struct)- will call -appdata-  to
write out every component of -Struct-. For example:

    define assign_c(Struct);
      appdata(Struct,save_field_c(%Struct,
                     datakey(Struct),consref(1)%));
    enddefine;

Here -save_field_c- is the procedure that does the work of writing out  the
components, using its partially applied arguments for information about the
parent structure. The procedure

        SAVE_DATA$-index

should be called  to generate a  new index for  a POP-11 data-structure  if
necessary. Thus,  usually  the -index-  of  a compound  component  will  be
written out rather than  the component, by the  procedure which saves  each
component.

Note that save_struct will have to treat some POP-11 data-structures rather
specially. This include:

    false, true, nil, termin, procedures, strings, ddecimals


    The "pr_header" entry is called initally to put out a header.
--------------------------------------------------------------------
pr_header(Struct) will  be called  before any  other output  is  attempted.
Typically it will print out header information on an output file.

Note that it -must- also evaluate SAVE_DATA$-index(Struct) either  directly
or indirectly, by calling a procedure that does. This will have the  effect
of generating a queue of structures  to be saved subsequently. If there  is
no queue, nothing gets saved.

This requirement of evaluation may appear bizarre - but it is not so if  we
think of saving a POP-11 simple item - in this case the header will contain
just that item and there is no  queue of sub-structures to be saved,  since
it -has- no sub-structures.


    The "pr_string" entry can save a string in the desired format.
------------------------------------------------------------------
Because strings  are not  normally treated  as -compound  data objects-  by
-save_data-, you  must  use  this  capability to  redefine  the  output  of
strings.

    "pr_trailer" is called finally. It may close the output file
--------------------------------------------------------------------

    The "FileSpec" entry specifies where the output is to go.
---------------------------------------------------------------
This entry specifies a file or repeater in the same way as the non-property
second argument of -save_data-.

    An example - making an array that indexes a structure.
----------------------------------------------------------

lvars index = SAVE_DATA$-index;


define save_in_array(Struct)->A;
    lvars A = newarray([1 1000], undef);
    define lvars save_s(Struct);
        lvars i = index(Struct);
        Struct -> A(i);
        if class_field_spec(datakey(Struct)) then
            appdata(Struct,index<>erase);
        endif;
    enddefine;

    define lvars header(Struct);
        [% 'saved-data', index(Struct) %] -> pdprops(A) ;

    enddefine;
    save_data(Struct, newassoc([
                [pr_header ^header]
                [save_struct ^save_s]
                [FileSpec ^charout]
                [pr_trailer ^erase]
                ])) -> ;
enddefine;

save_in_array({3 4 [5]}) -> A;
arrayvector(A) =>
 ** {{3 4 [5] } 3 4 [5] 5 [] undef undef undef undef undef ...}
pdprops(A) =>
** [saved-data 1]

restore_data provides more capabilities than datafile
-----------------------------------------------------
The scope is extended primarily to include circular structures. In addition
double precision floating point numbers ("ddecimals") are written with  the
appropriate number of significant digits to be accurately restored.

Two separate procedures are provided for  saving and restoring since it  is
anticipated that there  will be  applications where  only one  of these  is
required.

A simple way of defining save and restore "methods" is provided.

Use with lib objectclass
------------------------
These procedures will save objects generated with lib objectclass, and will
restore them, provided  that the  specification of  object classes  remains
constant between  saving and  restoring. The  "methods" draw  on the  older
paradigm of  class_...  procedures rather  than  being methods  within  lib
objectclass, since this library is not intended to require lib  objectclass
to be loaded.

============================================================================


/*
save_data.p                         Robin Popplestone MAR 1994

This file may be freely copied and modified provide the above attribution
is preserved or extended as appropriate.

         CONTENTS - (Use <ENTER> g to access required sections)

 --  before_obj(x,y) compares the index of two structures to support sorting.
 --  index(Struct) is the index number of an structure in the save-file.
 --  assign_index forces an structure and its sub-structures to have indices.
 --  save_field(Struct) writes out a record or vector component.
 --  save_struct(Struct) writes the index, components of the structure
 --  save_data(Struct,FileSpec) is the main procedure which writes Struct.
 --  Errata and inefficiencies.

*/

section SAVE_DATA => save_data;

vars procedure(
    before = nonop <=,
    class_save = newassoc([]),
    pr_header, pr_trailer,
    P_index,
    P_prop);

vars i_last = 0;
vars i_written = 0;
vars List_Deferred = [];
vars Struct_now = undef;


/*
before_obj(x,y) compares the index of two structures to support sorting.
-----------------------------------------------------------------
*/
define lconstant before_obj(x,y);
  before(P_index(x), P_index(y));
enddefine;

;;; trace SAVE_DATA$-before;


/*
index(Struct) is the index of an structure in the save-file.
------------------------------------------------------------
If Struct does not occur in P_index, then (1) we assign the next free
index number to it, and record it in the List_Deferred for future output.
*/

define new_index(Struct); lvars Struct;
   i_last + 1 ->> i_last;
enddefine;

define  index(Struct) -> i;
        lvars i = P_index(Struct);
        if i then return;
        endif;
        new_index(Struct) ->> P_index(Struct) -> i;   /* 1 */
        Struct::List_Deferred -> List_Deferred;
enddefine;

/*
assign_index forces an structure and its sub-structures to have indices.
------------------------------------------------------------------------
*/

define lconstant assign_index(Struct);      lvars Struct;
    if P_index(Struct) then return
    endif;
    if iscompound(Struct) then
        if isproperty(Struct) then                                 ;;; P1
            assign_index(property_default(Struct));
        elseif isarray(Struct) then                                ;;; A1
            assign_index(arrayvector(Struct));
        endif;

        if     Struct == false or Struct == true
        or Struct == termin or Struct == []
        or (isprocedure(Struct) and not(isclosure(Struct))
            and not(isproperty(Struct)) and not(isarray(Struct)))

        or isword(Struct) or isstring(Struct) then
        else
             index(Struct)->;
             appdata(Struct,assign_index);
        endif
    else spr(Struct)
    endif;
enddefine;

define  pr_string(S);
  lvars i,S;
  cucharout(`'`);
  for i from 1 to datalength(S) do
     lvars c = subscrs(i,S);
     if c = `'` or c = `\\` then cucharout(`\\`);
     endif; cucharout(c);
  endfor; cucharout(`'`);
enddefine;


/*
save_field(Struct) writes out a record or vector component.
----------------------------------------------------------
If Struct is a simple item or is  a certain kind of compound item (1-7) it  is
written out either "as itself" (e.g. as a  string) or as the name of a  global
variable or constant whose value is expected to be itself (e.g. false). At (5)
we check that  a procedure  can (one hopes)  be reconstituted  from its  name.
Otherwise (8) we write out the index for the structure in parentheses.

Properties require  special treatment  (P1).  Because it  is not  possible  to
update all the components of a property, e.g. the default-value, we have to be
sure to assign index  numbers for the components  of the property -before-  we
assign that of the property, so that the restore_data procedure does not  have
to update a  forward reference  to the  components. [??  Note if  we did  this
systematically, we could reduce forward  references in the restore_data  proc.
with some gain in efficiency.]

This procedure is -not- lconstant.
*/

define  save_field(Struct);      lvars Struct;
    if iscompound(Struct) then
        if isproperty(Struct) then                                 ;;; P1
            assign_index(property_default(Struct));
            lvars AList = datalist(Struct);
            AList -> P_prop(Struct);
             assign_index(AList);
        elseif isarray(Struct) then                                ;;; A1
            index(arrayvector(Struct)) -> ;
        endif;

        if     Struct == false then spr("false");                  ;;; (1)
        elseif Struct == true then spr("true");                    ;;; (2)
        elseif Struct == termin then spr("termin");                ;;; (3)
        elseif Struct == [] then  spr("nil");                      ;;; (4)
        elseif isprocedure(Struct) and not(isclosure(Struct))         ;;; (5)
            and not(isproperty(Struct)) and not(isarray(Struct))
            then
            lvars Name = pdprops(Struct);
            if isword(Name) and  valof(Name) = Struct then spr(Name);
            else mishap('save_data needs procedure with name=valof',
                    [^Struct pdprops ^Name saving ^Struct_now]);
            endif;
        elseif isword(Struct) then pr('"\''); pr(Struct); pr('\'"');  ;;; (6)
        elseif isstring(Struct) then                               ;;; (7)
            dlocal pop_pr_quotes = true;
            pr_string(Struct);
        elseif isddecimal(Struct) then
             lvars n_before = max(1,intof(log10(Struct) + 1));
             lvars n_after  = max(1,20 - n_before);
             prnum(Struct,n_before,n_after);
             pr(' ');
        else                                                    ;;; (8)
            pr('('); pr(index(Struct)); pr(')');
        endif
    else spr(Struct)
    endif;
enddefine;



/*
save_struct(Struct) writes the index, components of the structure
-----------------------------------------------------------------
We store Struct to Struct_now in (0) to support better error reporting.
At (1) we check to see if the structure has already been
written (?? can this occur...), and return if it has.
we make sure that the structure has components in a meaningful
sense, which it should do. Given that it does, at (2) we see if there
is a user defined -class_save- procedure, and call it if there is.
Otherwise (3) we make sure that we don't have a "simple" compound structure
like -true- which should have been written out by -save_field- and so
should not have been given to -save_struct-.
So, at (4) we actually have an structure with components.
We treat the special cases of properties (P), closures (C) and
arrays (A). In each case we generate output as specified in HELP * SAVE_DATA.

At (P) we are writing a property. The global -P_prop- will contain the index
of the data-list of the property. This must not be a forward reference,
so save_field will have made sure it is not by writing it when the first
the property is encountered. Likewise save_field has made sure that the
default value does not contain a forward reference.

At (A) we are writing an array. We can output the boundslist (A1) by spr
because it must be all integers, thus avoiding an inadmissable
forward reference. We save the -pdprops- of the array. We do NOT save
the updater because the updater of an array can't be changed anyway.

Writing out closures (C) is straightforward - we save the pdpart and
updater. The frozvals are saved as part of the default operation of
save_struct.

Finally, in the general case (G), we write the dataword followed by
all the components, written out with save_field.

We should never arrive at (6), since non-compound structures will be output
directly.

*/

lconstant Msg_ss = 'Error in save_data-this should not happen';

define  save_struct(Struct);
    lvars Struct;
    Struct -> Struct_now;                                   ;;; (0)
    if iscompound(Struct) then                              ;;; (1)
        lvars i = index(Struct);
        if before(i,i_written)  then return;
        endif;
        pr('\n');
        spr(i);
        lvars P_save = class_save(datakey(Struct));         ;;; (2)
        if P_save then
            spr(dataword(Struct)); P_save(Struct); pr(";");
            return;
        elseif  Struct == false or Struct == true           ;;; (3)
        or Struct == termin or Struct == []
        or (isprocedure(Struct) and not(isclosure(Struct))
            and not(isarray(Struct))) then
            mishap(Msg_ss,[^Struct]);
        else                                                ;;; (4)
            if isproperty(Struct) then                      ;;; (P);
                spr('%p'); save_field(P_prop(Struct));
                save_field(property_size(Struct));
                save_field(property_default(Struct));
                save_field(pdprops(Struct));
                if pdprops(pdpart(updater(Struct)))=
                    '(->Sys$-Prop$-Get)'
                then
                    save_field(false)
                else
                    save_field(updater(Struct));
                endif;
                return;
            elseif isclosure(Struct) then                  ;;; (C)
                spr('%c'); save_field(pdpart(Struct));
                save_field(pdprops(Struct));
                save_field(updater(Struct));
            elseif isarray(Struct) then                    ;;; (A)
                spr('%a');
                spr(boundslist(Struct));                   ;;; (A1)
                save_field(arrayvector(Struct));
                save_field(array_subscrp(Struct));
                lvars (mx,mn) = arrayvector_bounds(Struct);
                spr(mn); spr(mx);
                save_field(isarray_by_row(Struct));
                save_field(pdprops(Struct));
                return;
            else                                           ;;; (G)
                spr(dataword(Struct));
            endif;
            appdata(Struct,save_field); pr(";");
            i -> i_written;
        endif
    else
        mishap('save_data error - this should not occur',
            [^Struct ^Struct_now])
    endif;
enddefine;


/*
save_data(Struct,FileSpec) is the main procedure which writes Struct.
---------------------------------------------------------------------
Struct can be any savable POP-11  data-structure (i.e. item), and FileSpec  is
either a string or an character consumer.

We begin  (1) by  converting  a file  name into  a  consumer, Sink,  which  is
assigned to cucharout (2), so that we normally just "print" structures. Having
suppressed printing quotes on strings (3) we print the header on the save-file
(4), and then (5)  make a property that  will hold the correspondence  between
data-structures and their index  in the save-file and  the property that  will
hold  the  correspondence   between  a  property   occurring  in  the   user's
data-structure and  its association-list.  (A Property  is tricky  to  restore
because we can't just make a property and then update its association list  as
a single object,  so it must  not have forward  references to its  association
list or to its default value).

At (6) we zero  the counts for  the last index-value to  be allocated and  the
most recent index-value to have been  written. Then (7) we call save_field  to
write out a specification of the entire data-structure being saved. This  will
normally be an index of  a structure specified fully  later in the file.  Thus
writing "(35)"  will specify  that  the 35'th  structure  is the  actual  data
structure being saved.

A side-effect of "save_field"  will have been to  create a list of  structures
which have to be  written out, held in  -List_Deferred-. We iterate (8)  first
sorting the list by  index-number so that the  structures are written in  that
order, and then calling save_struct to write out each. Thus the vector {1 [2]
3} might be written out as

    21 vector 1 (22)3 ;

Here 21 is the index of the vector itself, (22) is the index of the list  cell
for [2]. The numbers 1 and 3 are represented by themselves.
Finally (9), no more structures  remain to be written out,  so we tidy up  the
output file and close it.

*/
define lconstant try(Prop,Key,Default)->Val;
  Prop(Key) -> Val;
  if Val then Val else Default
  endif -> Val;
enddefine;


define save_data(Struct,FileSpec) -> P_index;
    lvars Struct,FileSpec;
    dlocal before, class_save, P_index, pr_header, pr_string, pr_trailer,
           new_index, save_field, save_struct;

    newproperty([],128,false,"tmparg") -> P_index;

    if isproperty(FileSpec) then
       try(FileSpec,"before",before) -> before;
       try(FileSpec,"class_save",class_save) -> class_save;
       try(FileSpec,"new_index",new_index) -> new_index;
       try(FileSpec,"save_field",save_field) -> save_field;
       try(FileSpec,"save_struct",save_struct) -> save_struct;
       try(FileSpec,"pr_header",pr_header)   -> pr_header;
       try(FileSpec,"pr_string",pr_string)   -> pr_string;
       try(FileSpec,"pr_trailer",pr_trailer)   -> pr_trailer;
       FileSpec("FileSpec") -> FileSpec;
    endif;
    lvars  Sink = if isstring(FileSpec) then                 ;;; (1)
               discout(FileSpec);
            else FileSpec
            endif;

    dlocal tracing  = false;
    dlocal cucharout = Sink;                            ;;; (2)
    dlocal pop_pr_quotes = false;                       ;;; (3)
    [] -> List_Deferred;
    newproperty([],32,false,"tmparg")  -> P_prop;
    0 -> i_last; 0 -> i_written;                        ;;; (6)
    pr_header(Struct);
    ;;; index(Struct) -> ;    NO NO NO
    until null(List_Deferred) do                        ;;; (8)
        syssort(List_Deferred, before_obj) -> List_Deferred;
        dest(List_Deferred) -> (Struct,List_Deferred);
        save_struct(Struct);
    enduntil;
    pr_trailer(Struct);
enddefine;

define pr_trailer(Struct);
    pr('\n');                                           ;;; (9)
    pr(termin);
enddefine;

define pr_header(Struct);
    pr('\nSavedData '); pr('V1\n');                     ;;; (4)
    printf('\'%p\'\n',[%sysdaytime()%]);
    save_field(Struct);                                 ;;; (7)
enddefine;

/*


save_data(false,cucharout) ->;

save_data('can\'t use \\', charout);  ;;; but we can now.
vars circular = [44 fred 'ab' [55 66] last];
circular -> circular.tl.tl.tl.tl.tl;
save_data(circular,'~/circ.tmp')->;
save_data(circular,cucharout)->;
save_data(sin(%23%),'test.tmp')->;
save_data([ [66]],'test.tmp')->;
save_data(66,'test.tmp')->;
save_data('the cat','test.tmp')->;
save_data([%sin(%23%)%],charout);
save_data([%sin(%23%)%],'closure.tmp');
vars P =newproperty([[girl nighean]],34,[query],"perm");
save_data(P,'prop.tmp');
save_data(P,charout);
save_data(newarray([1 2 1 3],nonop +),charout);

save_data("cat",charout);
vars A = newarray([1 2 1 3],nonop +);
save_data(A,charout);
save_data(sin,charout);

/* DOES NOT WORK
npr -> SAVE_DATA$-class_save(string_key);
save_data(['fred'],charout);
*/

save_data(['fred'], newassoc([[pr_string ^npr][FileSpec ^charout]]));
save_data(newarray([1 3],nonop :: (%[end]%)),'array1.tmp') =>

lvars index = SAVE_DATA$-index;


define save_in_array(Struct)->A;
    lvars A = newarray([1 1000], undef);
    define lvars save_s(Struct);
        lvars i = index(Struct);
        Struct -> A(i);
        if class_field_spec(datakey(Struct)) then
            appdata(Struct,index<>erase);
        endif;
    enddefine;

    define lvars header(Struct);
        [% 'saved-data', index(Struct) %] -> pdprops(A) ;

    enddefine;
    save_data(Struct, newassoc([
                [pr_header ^header]
                [save_struct ^save_s]
                [FileSpec ^charout]
                [pr_trailer ^erase]
                ])) -> ;
enddefine;

save_in_array({3 4 [5]}) -> A;
arrayvector(A) =>
 ** {{3 4 [5] } 3 4 [5] 5 [] undef undef undef undef undef ...}
pdprops(A) =>
** [saved-data 1]
*/

/*
Errata and inefficiencies.
--------------------------
We do not check the updater of properties and arrays to make sure the
user has not sneaked in a different one.

Circular properties cause a nasty crash.

We cannot restore content-hashed properties.

It is inefficient to sort the List_Deferred every time we write a structure.

*/

endsection;

==============================================================================


/*
restore_data.p                                      Robin Popplestone MAR94

This file may be freely copied and modified, provided the attribution above is
preserved or extended as appropriate.

         CONTENTS - (Use <ENTER> g to access required sections)

 --  Introduction
 --  process_file(Rep,PR) applies PR to each record available from Rep
 --  check_serial_number compares the serial number of a record with expected val.
 --  restore_field reads an entry corresponding to a record-field or vector-entry.
 --  restore_list reads the boundslist of an array record.
 --  restore_proc reads a procedure object - array, closure or property
 --  restore_key reads information about a key for a  data-class
 --  restore_object makes a POP-11 record or vector as specified in the file
 --  update_proc gives final values to the updatable fields of a procedure
 --  update_object fills in forward references in general records/vectors.
 --  restore_data(FileName) rebuilds a saved object stored in a file

Introduction
------------
restore_data reads back an object that has been written to disc as a file.
It first checks that the file begins with the word "SavedData". If not,
the file is assumed to be in the old "datafile" format. Otherwise,
a version description is read.

Then it builds the object in two passes.

In pass (1) we  make a new  POP-11 object (record,  vector, closure) for  each
record in the file, filling in  everything except forward references to  other
objects, and  building  a  directory,  Object, which  maps  from  the  numeric
identifiers of objects in the file to the actual POP object.

In pass (2) we fill in the unfilled forward references.
*/
uses int_parameters;
section SAVE_DATA pop_max_int => restore_data;

lvars procedure Object;

/* These procedures are externally available from within the section */

vars procedure (
    class_restore = newassoc([]),
    class_update  = newassoc([]),
    restore_field,
);

/*
process_file(Rep,PR) applies PR to each record available from Rep
----------------------------------------------------------------
Use the repeater Rep to go through a file, applying the procedure
ProcessRecord to operate on objects in the file.  The variable -m- holds
the serial number of each record read. These are numbered in the
file, so a consistency check is provided.
*/

define lconstant process_file(Rep,ProcessRecord);
    lvars Rep,ProcessRecord;
    lvars m=1;
    repeat
        lvars (Obj,not_last) = ProcessRecord(Rep,m);
        unless not_last then return
        endunless;
        m+1->m;
    endrepeat
enddefine;

/*
check_serial_number compares the serial number of a record with expected val.
-----------------------------------------------------------------------------
*/

define lconstant check_serial_number(Rep,m);
  lvars Item = Rep();
  if Item = termin then return(false)
  endif;
  unless Item == m then
    mishap('Serial number of record does not match',[^Item^m]);
  endunless;
  true;
enddefine;

/*
stack_fields(Rep,m) stacks up fields read from Rep, pushes a count.
--------------------------------------------------------------------
stack up fields read from Rep until a ";" is read. Put count on
top of stack.
*/

define  stack_fields(Rep,m);
    lvars Rep,m;
    #|repeat
            lvars (ExOb_i,is_ptr) = restore_field(Rep,m); ;;; (6)
            quitif(is_ptr==termin);
            ExOb_i;
    endrepeat|#
enddefine;


/*
restore_field reads an entry corresponding to a record-field or vector-entry.
----------------------------------------------------------------------------
Here Rep is the item-repeater for the file. m is the index of the latest
record formed. Any reference to a file-record preceding m can be finalised.
Forward references have to be postponed.
restore_field(Rep,m) -> (Obj,flag)

If the flag = termin then we have read the last field in the object.
If the flag = true then Obj is an integer index to a forward reference
If the flag = false then Obj is the actual finalised POP-11 object

(1) A general POP-11 compound item is represented as a number enclosed in
parentheses, the number being the serial number of its entry in the data-file.
(2) If this serial number is less than that of the current record, then
it can be replaced by the actual POP-11 item, recorded in  Object.
(3) A POP-11 word is written out as a string enclosed in both string quotes
and word quotes (e.g. "'fred'" is the word "fred"). This is not bomb-proof,
but should catch most instances.
(4) A semicolon is not a field, but indicates that the last field of
the current record/vector has been read.
(5) An unquoted word is replaced by its value. This is done mostly for
named procedures, and a few quasi-simple objects like false and nil.
(6) Any other item, (primarily a number) stands for itself.

*/

define  restore_field(Rep,m);                     ;;; Not lconstant.
  lvars Rep,m;
  lvars Ob1 = Rep();
  if Ob1 = "(" then                            ;;; (1) General compound item
    lvars Ob2 = Rep();
    lvars Cbkt= Rep();
    unless isnumber(Ob2) and Cbkt = ")" then
      mishap('Illegal form for file-record',
      [%Ob1,Ob2,Cbkt%]);
    endunless;
    if Ob2<= m then Object(Ob2),false          ;;; (2) backward reference
    else Ob2,true
    endif;
  elseif Ob1 == """ then                       ;;; (3) quoted word (as string)
    lvars Ob2 = Rep();
    lvars Qt = Rep();
    unless isstring(Ob2) and Qt = """ then
       mishap('Illegal quoted word in file-record',
               [%Ob1,Ob2,Qt%]);
    endunless;
    Ob2,false
  elseif Ob1 == ";" then false,termin           ;;; (4) ";" terminates
  elseif isword(Ob1) then valof(Ob1),false      ;;; (5) word - use the value
  else Ob1,false;                               ;;; (6) simple item
  endif;
enddefine;

/*
restore_list reads the boundslist of an array record.
--------------------------------------------------
Other lists are handled in the same way as any other record, i.e. they
are build up of pairs flagged by their dataword. We treat boundslists
specially to avoid forward reference, since we cannot update the boundslist
of an array. There is no problem about bounslists because they contain
simple items only.
*/

define lconstant restore_list(Rep);
  lvars Rep,Obj;
  unless Rep() = "[" then
    mishap('List needed-bad save file for restore_data',[])
  endunless;
  [%until (Rep() ->> Obj) == "]" do
      Obj;
  enduntil%]
enddefine;

/*
restore_proc reads a procedure object - array, closure or property
--------------------------------------------------------------
If a record in the file is a procedure object, this is indicated by
a "%" sign in the dataword position, followed by either "a" (for "array")
"c" (for closure) or "p" for property. Named procedures are NOT represented
by separate records, instead their name occurs directly in a field,
save_data having checked that the pdprops matches the valof.

The main problem in restoring these procedure objects is that not all
components are updatable, so that certain forward references have to be
avoided. The save_data procedure, which wrote the data-file in the first
place, knows this and is at pains to avoid these forward references.

At (1) we read the word which indicates whether we have an array,
closure or property, and take the A.. C.. or P.. branches of the conditional.

At (A1) we start reading the various arguments that are to be given to
newanyarray (A8) to reconstitute the array. We read the bounds-list (A2),
the vector of data for the array (A3), the subscripting procedure (A4)
and the index of the first element of the vector -actually- to be used (A5).
The  field is skipped - it is the pdprops, restored on update..

At (C1) we treat a closure. We read the -pdpart- (C2). If this is a forward
reference we replace it by -identfn- since we must have a procedure to
make a closure. Later of course this will be updated.

*/

define lconstant restore_proc(Rep,m) -> Obj;
    lvars Rep,m,Obj;
    lvars type = Rep();                                      ;;; (1)
    if type == "a" then                                      ;;; (A1) Array
        lvars Bounds     = restore_list(Rep);                   ;;; (A2)
        lvars (Vec,_)    = restore_field(Rep,m);                ;;; (A3)
        lvars (Sub,_)    = restore_field(Rep,m);                ;;; (A4)
        lvars (i1,_)     = restore_field(Rep,m);                ;;; (A5)
        restore_field(Rep,m) -> ; -> ;                          ;;; (A6)
        lvars (is_ByRow,_) = restore_field(Rep,m);              ;;; (A7)
        lvars A = newanyarray(Bounds,Vec,Sub,i1-1,is_ByRow); ;;; (A8)
        lvars (p,_)     = restore_field(Rep,m);                 ;;; (A9)
        A;
    elseif type == "c" then                                     ;;; (C1)
        consclosure( (lvars (F,is_ptr_F) = restore_field(Rep,m);), ;;; (C2)
            if is_ptr_F then identfn
            else F
            endif,
            (restore_field(Rep,m)->;->;),
            (restore_field(Rep,m)->;->;),
             stack_fields(Rep,m));
    elseif type == "p" then
        lvars (AList,_) = restore_field(Rep,m);
        lvars (size,bad_size)  = restore_field(Rep,m);
        lvars (default,bad_default) = restore_field(Rep,m);
        lvars (pdprop,_) = restore_field(Rep,m);
        lvars (udprop,_) = restore_field(Rep,m);
        if bad_size then mishap('Bad size spec for property',[^size]);
        endif;
        if bad_default then mishap('Bad default spec for property',[^default]);
        endif;
        newproperty([],size,default,"perm")
    else mishap('Illegal procedure type code',[^type]);

    endif -> Obj;

    Obj->Object(m);
enddefine;


/*
restore_key reads information about a key for a  data-class
----------------------------------------------------------
Read the name of a data-class. Form the corresponding key-name and check
that it has a value which is a key. If so, return the key.
*/

define lconstant restore_key(Rep);
    lvars ClassName = Rep();
    unless isword(ClassName) then
        mishap('Word needed for data-class name needed',
               [^ClassName]);
    endunless;
    if ClassName = "%" then                              ;;; Procedure
        ClassName
    else
        lvars KeyName = ClassName<>"_key";
        lvars Key = valof(KeyName);
        unless iskey(Key) then
            mishap('Name of data-key required',
                [^ClassName^KeyName^Key]);
        endunless;
        Key;
    endif
enddefine;


/*
restore_object makes a POP-11 record or vector as specified in the file
---------------------------------------------------------------------
The argument -Rep- is  an item repeater  for the input  data-file, and m  is a
count of the expected serial number for  the object to be read. The  procedure
returns Obj,  the actual  POP-11 object  which  will form  part of  the  final
restored data-structure (although components  which are forward references  of
it will  be later  updated),  except when  the  end-of-file is  reached,  when
not_last is set to -false-.

This procedure will report an error if there is a number-of-fields mismatch
on records. It may also generate an error if the object-identifiers are
numbers too big to fit in a record field or vector entry. Such an error
would otherwise be caught when the entry is updated.

At (1) we check that the expected and actual serial numbers match up
At (2) we read the data-key of the object. If (3) the word "%" is returned
instead, we have a procedure, and call restore_proc to deal with this case.
Otherwise (4) we read the fields (5) (or components) of the object, stacking
them up in the -repeat- loop, and counting the number of them in -n-.
At (6) we get POPLOG's field-specifier for the data-class and (7) check
that we have a record-class. In this case, the FS is a list, whose length
must match (8) the number of fields we have read. If so, we call the class
constructor (9) to build the record from the stacked components.

Otherwise (10) we have a vector-class, so we rebuild the vector of -n-
elements, using the class-constructor (11).

Finally (12) in either case we record the relationship between serial-number
and the actual object -Obj- that we have build in the property -Object-.
*/
lvars stmk_restore = 'stmk_restore';

define lconstant restore_object(Rep,m) -> (Obj,not_last);
    lvars Rep,m,Obj,
        not_last = check_serial_number(Rep,m);                  ;;; (1)
    unless not_last then return
    endunless;
    lvars  Key =  restore_key(Rep);                                ;;; (2)
    lvars P_restore = class_restore(Key);
    if P_restore then
        stmk_restore;
        P_restore(Rep,m) -> Obj;
        Obj -> Object(m);
        unless == (/*..*/,stmk_restore) then
          mishap('Class restore procedure of wrong arity',
                 [%P_restore,Obj,Key%]);
        endunless;
        return;
    endif;
    if Key == "%" then                                          ;;; (3)
        return(restore_proc(Rep,m) -> Obj);
    endif;
    lvars n = stack_fields(Rep,m);
    lvars FS = class_field_spec(Key);                           ;;; (6)
    if islist(FS) then                   ;;; Record class       ;;; (7)
    unless datalength(Key) = n then                             ;;; (8)
        mishap('Reading record: wrong number of fields',
               [%n,Key,FS%]);
    endunless;
        class_cons(Key)(/*...*/);         ;;; Make record       ;;; (9)
    else                                  ;;; Vector class.     ;;; (10)
        class_cons(Key)(/*..*/,n);        ;;; Make vector       ;;; (11)
    endif -> Obj;
    Obj->Object(m);                                             ;;; (12)
enddefine;

/*
update_proc gives final values to the updatable fields of a procedure
---------------------------------------------------------------------
*/


define lconstant update_proc(Rep,Obj,m);
    lvars Rep,m,Obj;
    lvars type = Rep();
    if type == "a" then                          ;;; Array
        lvars Bounds     = restore_list(Rep);
        lvars (Vec,_)    = restore_field(Rep,m);
        lvars (Sub,_)    = restore_field(Rep,m);
        lvars (i1,_)     = restore_field(Rep,m);
        restore_field(Rep,m) -> ; -> ;
        lvars (is_ByRow,_) = restore_field(Rep,m);
        lvars (p,_)     = restore_field(Rep,m);
        p -> pdprops(Obj);
    elseif type == "c" then
        lvars (ExPdr,is_ptr_p) = restore_field(Rep,m);
        if is_ptr_p then ExPdr -> pdpart(Obj);
        endif;
        lvars (p,_) = restore_field(Rep,m);
        p -> pdprops(Obj);
        lvars (u,_) = restore_field(Rep,m);
        u -> updater(Obj);
        repeat
            lvars (ExOb_i,is_ptr) = restore_field(Rep,m),i=1;
            if is_ptr = termin then return
            endif;
            if is_ptr then Object(ExOb_i) -> frozval(i,Obj);
            endif;
            i+1->i;
        endrepeat;

    elseif type == "p" then                                 ;;; property
        lvars (AList,_) = restore_field(Rep,m);
        lvars (size,bad_size)  = restore_field(Rep,m);
        lvars (default,bad_default) = restore_field(Rep,m);
        lvars (pdprop,_) = restore_field(Rep,m);
        pdprop -> pdprops(Obj);
        lvars Pair;
        for Pair in AList do
          hd(tl(Pair)) -> Obj(hd(Pair));
        endfor;
        lvars (u,_) = restore_field(Rep,m);
        if u then u -> updater(Obj);
        endif;
    else mishap('Illegal procedure type code',[^type]);

    endif ;;;-> Obj;

    ;;; Obj->Object(m);
enddefine;


/*
update_object fills in forward references in general records/vectors.
---------------------------------------------------------------------
We read the serial number(1), exiting (2) if we are at the end-of-file At (3),
having made m big to indicate that there are effectively no forward references
on  the  second  pass,  we  read  the  dataword,  normally  converted  to  the
corresponding key. "%"  indicates a  procedure, which is  handled by  separate
code (P).

Otherwise we stack up the fields on the input, and use them to -fill-
the data-structure.
*/

define lconstant update_object(Rep,m) -> (Obj,not_last);
    lvars Rep,m,Obj = Object(m),                         ;;; (1)
        not_last = check_serial_number(Rep,m);
    unless not_last then return                          ;;; (2)
    endunless;
    pop_max_int -> m;                                    ;;; (3)
    lvars  Key =  restore_key(Rep), i = 1;               ;;; (4)
    lvars P_update = class_update(Key);
    if P_update then
        P_update(Obj,Rep,m) -> Obj;
        return;
    endif;
    if Key == "%" then                                    ;;; (P)
        update_proc(Rep,Obj,m); return;
    elseif Key == undef_key then
    stack_fields(Rep,m) -> ; -> ;
    return;
    else fill((stack_fields(Rep,m)->),Obj) -> ;
    endif;
enddefine;


/*
restore_data(FileName) rebuilds a saved object stored in a file
----------------------------------------------------------------
The default syntax of the file is described in HELP * restore_data.
To restore an object we begin by making a repeater procedure which will give
us items (1). We use this to read the header, version.
If there is no header, we assume we have a datafile
and date (4..5). We
enable the reading of long strings (5) and create a property (6) which will
hold the mapping between object identifiers in the file and the actual POP-11
objects which are built. At (7) we use restore_field to read the identifier
of the object which is -actually being restored- (as opposed to its
sub-objects). If this is simple or quasi-simple the actual value will
be returned and the file will in fact end here, although we do not need to
worry about that. At (8) we take the first pass through the rest of the
input file to build up the directory of objects in -Object-. See below
for what happens then.
*/

define  restore_data(FileName)->Obj_out;
  lvars FileName;
  lvars Rep1 = incharitem(discin(FileName));      ;;; (1) Make item repeater
  lvars Hdr = Rep1();                             ;;; (2) Read header
  unless Hdr = "SavedData" then                   ;;; (3) Compatibility
    popval([datafile(^FileName)]) -> Obj_out;     ;;; with datafile
    npr('*** File restored using datafile *** ');
    npr('  You need to update your saved-data ');
    return;
  endunless;
  lvars Version = Rep1();                         ;;; (4) and version
  lvars Date    = Rep1();                         ;;;     and date
  dlocal pop_longstrings = true;                  ;;; (5)
  dlocal Object = newassoc([]);                   ;;; (6)
  lvars (Obj,is_index) = restore_field(Rep1,0) ;  ;;; (7)
  process_file(Rep1,restore_object);              ;;; (8) First pass

/*
This is the second pass through the input. We proceed as before...
*/
  lvars Rep2 = incharitem(discin(FileName));      ;;; (9)
  Rep2()->; Rep2()->; Rep2()->;                   ;;; (10) Discard info
  lvars (_,_) = restore_field(Rep2,0);
  process_file(Rep2,update_object);             /*  Pass (2)  */
  if is_index then Object(Obj)
  else Obj
  endif -> Obj_out;
enddefine;

/*
;;; This does in fact work, but not with the -example- macro.

save_data('can\'t use \\ and \^A','string.tmp');
datalist(restore_data('string.tmp'))=>
** [99 97 110 39 116 32 117 115 101 32 92 32 97 110 100 32 1]

;;; Check datafile downward compatibility.

[2 3 4] -> datafile('datafile.tmp');
*** File restored using datafile ***
restore_data('datafile.tmp')=>
** [2 3 4]

example save_data


;;; Saving a single quasi-simple item.

save_data(false,'false.tmp') ->;
restore_data('false.tmp')=>
** <false>

;;; Circular list

vars circular = [44 fred 'ab' [55 66] last];
circular -> circular.tl.tl.tl.tl.tl;
save_data(circular,'circ.tmp')->;
vars L = restore_data('circ.tmp');       ;;; Infinite list - beware.
vars i;
pr('** '); for i from 1 to 10 do spr(L(i)); endfor
** 44 fred ab [55 66] last 44 fred ab [55 66] last

;;; Integers

save_data(654,'int.tmp') ->;
restore_data('int.tmp')=>
** 654

;;; Floats

true -> popdprecision;
save_data(sin(0.1), 'float.tmp') ->;
vars x = restore_data('float.tmp');
pr('\n**'); prnum(x,1,22);
sin(0.1)=>

;;; Simple list

save_data([2 3],'list.tmp') ->;
restore_data('list.tmp')=>
** [2 3]

save_data({[44][66]},'vector.tmp') ->;
restore_data('vector.tmp')=>

;;; Partial application.

save_data(sin(%23%),'partapply.tmp') ->;
vars S = restore_data('partapply.tmp');
pdpart(S) =>
** <procedure sin>
datalist(S)=>
** [23]

;;; Updater and pdpart of closures.

vars S = sin(%45,84%);
cos -> updater(S);
'funny' -> pdprops(S);
save_data(S,'partapply_S.tmp') ->;
vars S_read = restore_data('partapply_S.tmp');
S_read.datalist=>
** [45 84]
S_read.updater=>
** <procedure cos>
S_read.pdprops=>
** funny

save_data(23,'simp.tmp') ->;
restore_data('simp.tmp')=>
** 23

save_data('the cat','string.tmp') ->;
restore_data('string.tmp')=>
** the cat

vars P =newproperty([[girl nighean]],34,[query],"perm");
'Gaelic' -> pdprops(P);
save_data(P,'prop.tmp') ->;
vars P_r = restore_data('prop.tmp');
P_r=>
datalist(P_r)=>             ;;; more entries will appear in random order.
** [[girl nighean]]

save_data(newarray([1 2 1 3],nonop +),'array.tmp') ->;
vars A = restore_data('array.tmp');
A =>
** <array [1 2 1 3]>
datalist(A) =>
** [2 3 3 4 4 5]

save_data(newarray([1 3],nonop :: (%[end]%)),'array1.tmp') ->;
vars A1 = restore_data('array1.tmp');
A1 =>
** <array [1 3]>
datalist(A1) =>
** [[1 end] [2 end] [3 end]]

save_data({%undef,34%},'undef.tmp') ->;
restore_data('undef.tmp') =>

endexample;

/* This example checks that any string can be saved */

lvars i;
vars S_full = consstring(#|for i from 0 to 255 do i endfor |#);
save_data(S_full,'string_fl.tmp');
vars S_r = restore_data('string_fl.tmp');
for i from 0 to 255 do unless S_r(i+1) = i then
  mishap('string entry wrong',[^i]);
  endunless
endfor;

;;; This example will crash ---- circularity through property.

vars P =newproperty([[girl nighean]],34,[query],"perm");
P -> P("fred");
save_data(P,'prop_funny.tmp');

;;; This example uses affine spaces.
save_data(pt3(1,2,3),'point.tmp');
restore_data('point.tmp') =>

*/

endsection;