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;
|