summaryrefslogtreecommitdiff
path: root/Build/source/texk/web2c/mplibdir/memio.w
diff options
context:
space:
mode:
authorTaco Hoekwater <taco@elvenkind.com>2009-04-16 07:36:46 +0000
committerTaco Hoekwater <taco@elvenkind.com>2009-04-16 07:36:46 +0000
commit79e9c535970a1887e1b6b2196cd90775955ea486 (patch)
tree61c8bd011c749b0d0e732630e69bb3f3f07b7219 /Build/source/texk/web2c/mplibdir/memio.w
parent9a146db3a4562660570a744a7c7471132090a537 (diff)
This is an initial import of the current trunk state of MPlib
(version 1.110 and a few minor patches). For the moment, the mplib.am builds the executable "newmpost", that should be fixed soon. git-svn-id: svn://tug.org/texlive/trunk@12732 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Build/source/texk/web2c/mplibdir/memio.w')
-rw-r--r--Build/source/texk/web2c/mplibdir/memio.w405
1 files changed, 405 insertions, 0 deletions
diff --git a/Build/source/texk/web2c/mplibdir/memio.w b/Build/source/texk/web2c/mplibdir/memio.w
new file mode 100644
index 00000000000..d2393d0fb96
--- /dev/null
+++ b/Build/source/texk/web2c/mplibdir/memio.w
@@ -0,0 +1,405 @@
+% $Id: psout.w 616 2008-07-09 14:05:55Z taco $
+%
+% Copyright 2008 Taco Hoekwater.
+%
+% This program is free software: you can redistribute it and/or modify
+% it under the terms of the GNU Lesser General Public License as published by
+% the Free Software Foundation, either version 3 of the License, or
+% (at your option) any later version.
+%
+% This program is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+% GNU Lesser General Public License for more details.
+%
+% You should have received a copy of the GNU Lesser General Public License
+% along with this program. If not, see <http://www.gnu.org/licenses/>.
+%
+% TeX is a trademark of the American Mathematical Society.
+% METAFONT is a trademark of Addison-Wesley Publishing Company.
+% PostScript is a trademark of Adobe Systems Incorporated.
+
+% Here is TeX material that gets inserted after \input webmac
+
+\font\tenlogo=logo10 % font used for the METAFONT logo
+\def\MP{{\tenlogo META}\-{\tenlogo POST}}
+\def\title{MetaPost MEM reading and writing}
+\def\topofcontents{\hsize 5.5in
+ \vglue -30pt plus 1fil minus 1.5in
+ \def\?##1]{\hbox to 1in{\hfil##1.\ }}
+ }
+\def\botofcontents{\vskip 0pt plus 1fil minus 1.5in}
+\pdfoutput=1
+\pageno=3
+
+@ As usual, need true and false.
+
+@d true 1
+@d false 0
+@d null 0 /* the null pointer */
+@d incr(A) (A)=(A)+1 /* increase a variable by unity */
+@d decr(A) (A)=(A)-1 /* decrease a variable by unity */
+@d qo(A) (A) /* to read eight bits from a quarterword */
+@d qi(A) (quarterword)(A) /* to store eight bits in a quarterword */
+@d max_quarterword 0x3FFF /* largest allowable value in a |quarterword| */
+@d max_halfword 0xFFFFFFF /* largest allowable value in a |halfword| */
+@d max_str_ref 127 /* ``infinite'' number of references */
+
+
+@c
+#include "config.h"
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "mplib.h"
+#include "mpmp.h"
+
+@ @c void mp_store_mem_file (MP mp) {
+ integer k; /* all-purpose index */
+ pointer p,q; /* all-purpose pointers */
+ integer x; /* something to dump */
+ four_quarters w; /* four ASCII codes */
+ memory_word WW;
+ @<Create the |mem_ident|, open the mem file,
+ and inform the user that dumping has begun@>;
+ @<Dump constants for consistency check@>;
+ @<Dump the string pool@>;
+ @<Dump the dynamic memory@>;
+ @<Dump the table of equivalents and the hash table@>;
+ @<Dump a few more things and the closing check word@>;
+ @<Close the mem file@>;
+}
+
+@ Corresponding to the procedure that dumps a mem file, we also have a function
+that reads~one~in. The function returns |false| if the dumped mem is
+incompatible with the present \MP\ table sizes, etc.
+
+@d too_small(A) { wake_up_terminal;
+ wterm_ln("---! Must increase the "); wterm((A));
+@.Must increase the x@>
+ goto OFF_BASE;
+ }
+
+@c
+boolean mp_load_mem_file (MP mp) {
+ integer k; /* all-purpose index */
+ pointer p,q; /* all-purpose pointers */
+ integer x; /* something undumped */
+ str_number s; /* some temporary string */
+ four_quarters w; /* four ASCII codes */
+ memory_word WW;
+ @<Undump the string pool@>;
+ @<Undump the dynamic memory@>;
+ @<Undump the table of equivalents and the hash table@>;
+ @<Undump a few more things and the closing check word@>;
+ return true; /* it worked! */
+OFF_BASE:
+ wake_up_terminal;
+ wterm_ln("(Fatal mem file error; I'm stymied)\n");
+@.Fatal mem file error@>
+ return false;
+}
+
+@ Mem files consist of |memory_word| items, and we use the following
+macros to dump words of different types:
+
+@d dump_wd(A) { WW=(A); (mp->write_binary_file)(mp,mp->mem_file,&WW,sizeof(WW)); }
+@d dump_int(A) { int cint=(A); (mp->write_binary_file)(mp,mp->mem_file,&cint,sizeof(cint)); }
+@d dump_hh(A) { WW.hh=(A); (mp->write_binary_file)(mp,mp->mem_file,&WW,sizeof(WW)); }
+@d dump_qqqq(A) { WW.qqqq=(A); (mp->write_binary_file)(mp,mp->mem_file,&WW,sizeof(WW)); }
+@d dump_string(A) { dump_int((int)(strlen(A)+1));
+ (mp->write_binary_file)(mp,mp->mem_file,A,strlen(A)+1); }
+
+@ The inverse macros are slightly more complicated, since we need to check
+the range of the values we are reading in. We say `|undump(a)(b)(x)|' to
+read an integer value |x| that is supposed to be in the range |a<=x<=b|.
+
+@d mgeti(A) do {
+ size_t wanted = sizeof(A);
+ void *A_ptr = &A;
+ (mp->read_binary_file)(mp, mp->mem_file,&A_ptr,&wanted);
+ if (wanted!=sizeof(A)) goto OFF_BASE;
+} while (0)
+
+@d mgetw(A) do {
+ size_t wanted = sizeof(A);
+ void *A_ptr = &A;
+ (mp->read_binary_file)(mp, mp->mem_file,&A_ptr,&wanted);
+ if (wanted!=sizeof(A)) goto OFF_BASE;
+} while (0)
+
+@d undump_wd(A) { mgetw(WW); A=WW; }
+@d undump_int(A) { int cint; mgeti(cint); A=cint; }
+@d undump_hh(A) { mgetw(WW); A=WW.hh; }
+@d undump_qqqq(A) { mgetw(WW); A=WW.qqqq; }
+@d undump_strings(A,B,C) {
+ undump_int(x); if ( (x<(A)) || (x>(B)) ) goto OFF_BASE; else C=str(x); }
+@d undump(A,B,C) { undump_int(x);
+ if ( (x<(A)) || (x>(int)(B)) ) goto OFF_BASE; else C=x; }
+@d undump_size(A,B,C,D) { undump_int(x);
+ if (x<(A)) goto OFF_BASE;
+ if (x>(B)) too_small((C)); else D=x; }
+@d undump_string(A) {
+ size_t the_wanted;
+ void *the_string;
+ integer XX=0;
+ undump_int(XX);
+ the_wanted = (size_t)XX;
+ the_string = mp_xmalloc(mp,(size_t)XX,1);
+ (mp->read_binary_file)(mp,mp->mem_file,&the_string,&the_wanted);
+ A = (char *)the_string;
+ if (the_wanted!=(size_t)XX) goto OFF_BASE;
+}
+
+@ The next few sections of the program should make it clear how we use the
+dump/undump macros.
+
+@<Dump constants for consistency check@>=
+x = metapost_magic; dump_int(x);
+dump_int(mp->mem_top);
+dump_int((integer)mp->hash_size);
+dump_int(mp->hash_prime)
+dump_int(mp->param_size);
+dump_int(mp->max_in_open);
+
+@ Sections of a \.{WEB} program that are ``commented out'' still contribute
+strings to the string pool; therefore \.{INIMP} and \MP\ will have
+the same strings. (And it is, of course, a good thing that they do.)
+@.WEB@>
+@^string pool@>
+
+@ @c
+int mp_undump_constants (MP mp) {
+ integer x;
+ undump_int(x);
+ if (x!=metapost_magic) return x;
+ undump_int(x); mp->mem_top = x;
+ undump_int(x); mp->hash_size = (unsigned)x;
+ undump_int(x); mp->hash_prime = x;
+ undump_int(x); mp->param_size = x;
+ undump_int(x); mp->max_in_open = x;
+ return metapost_magic;
+ OFF_BASE:
+ return -1;
+}
+
+@ We do string pool compaction to avoid dumping unused strings.
+
+@d dump_four_ASCII
+ w.b0=qi(mp->str_pool[k]); w.b1=qi(mp->str_pool[k+1]);
+ w.b2=qi(mp->str_pool[k+2]); w.b3=qi(mp->str_pool[k+3]);
+ dump_qqqq(w)
+
+@<Dump the string pool@>=
+mp_do_compaction(mp, mp->pool_size);
+dump_int(mp->pool_ptr);
+dump_int(mp->max_str_ptr);
+dump_int(mp->str_ptr);
+k=0;
+while ( (mp->next_str[k]==k+1) && (k<=mp->max_str_ptr) )
+ k++;
+dump_int(k);
+while ( k<=mp->max_str_ptr ) {
+ dump_int(mp->next_str[k]); incr(k);
+}
+k=0;
+while (1) {
+ dump_int(mp->str_start[k]); /* TODO: valgrind warning here */
+ if ( k==mp->str_ptr ) {
+ break;
+ } else {
+ k=mp->next_str[k];
+ }
+}
+k=0;
+while (k+4<mp->pool_ptr ) {
+ dump_four_ASCII; k=k+4;
+}
+k=mp->pool_ptr-4; dump_four_ASCII;
+mp_print_ln(mp); mp_print(mp, "at most "); mp_print_int(mp, mp->max_str_ptr);
+mp_print(mp, " strings of total length ");
+mp_print_int(mp, mp->pool_ptr)
+
+@ @d undump_four_ASCII
+ undump_qqqq(w);
+ mp->str_pool[k]=(ASCII_code)qo(w.b0); mp->str_pool[k+1]=(ASCII_code)qo(w.b1);
+ mp->str_pool[k+2]=(ASCII_code)qo(w.b2); mp->str_pool[k+3]=(ASCII_code)qo(w.b3)
+
+@<Undump the string pool@>=
+undump_int(mp->pool_ptr);
+mp_reallocate_pool(mp, mp->pool_ptr) ;
+undump_int(mp->max_str_ptr);
+mp_reallocate_strings (mp,mp->max_str_ptr) ;
+undump(0,mp->max_str_ptr,mp->str_ptr);
+undump(0,mp->max_str_ptr+1,s);
+for (k=0;k<=s-1;k++)
+ mp->next_str[k]=k+1;
+for (k=s;k<=mp->max_str_ptr;k++)
+ undump(s+1,mp->max_str_ptr+1,mp->next_str[k]);
+mp->fixed_str_use=0;
+k=0;
+while (1) {
+ undump(0,mp->pool_ptr,mp->str_start[k]);
+ if ( k==mp->str_ptr ) break;
+ mp->str_ref[k]=max_str_ref;
+ incr(mp->fixed_str_use);
+ mp->last_fixed_str=k; k=mp->next_str[k];
+}
+k=0;
+while ( k+4<mp->pool_ptr ) {
+ undump_four_ASCII; k=k+4;
+}
+k=mp->pool_ptr-4; undump_four_ASCII;
+mp->init_str_use=mp->fixed_str_use; mp->init_pool_ptr=mp->pool_ptr;
+mp->max_pool_ptr=mp->pool_ptr;
+mp->strs_used_up=mp->fixed_str_use;
+mp->pool_in_use=mp->str_start[mp->str_ptr]; mp->strs_in_use=mp->fixed_str_use;
+mp->max_pl_used=mp->pool_in_use; mp->max_strs_used=mp->strs_in_use;
+mp->pact_count=0; mp->pact_chars=0; mp->pact_strs=0;
+
+@ By sorting the list of available spaces in the variable-size portion of
+|mem|, we are usually able to get by without having to dump very much
+of the dynamic memory.
+
+We recompute |var_used| and |dyn_used|, so that \.{INIMP} dumps valid
+information even when it has not been gathering statistics.
+
+@<Dump the dynamic memory@>=
+mp_sort_avail(mp); mp->var_used=0;
+dump_int(mp->lo_mem_max); dump_int(mp->rover);
+p=0; q=mp->rover; x=0;
+do {
+ for (k=p;k<= q+1;k++)
+ dump_wd(mp->mem[k]);
+ x=x+q+2-p; mp->var_used=mp->var_used+q-p;
+ p=q+node_size(q); q=rmp_link(q);
+} while (q!=mp->rover);
+mp->var_used=mp->var_used+mp->lo_mem_max-p;
+mp->dyn_used=mp->mem_end+1-mp->hi_mem_min;
+for (k=p;k<= mp->lo_mem_max;k++ )
+ dump_wd(mp->mem[k]);
+x=x+mp->lo_mem_max+1-p;
+dump_int(mp->hi_mem_min); dump_int(mp->avail);
+for (k=mp->hi_mem_min;k<=mp->mem_end;k++ )
+ dump_wd(mp->mem[k]);
+x=x+mp->mem_end+1-mp->hi_mem_min;
+p=mp->avail;
+while ( p!=null ) {
+ decr(mp->dyn_used); p=mp_link(p);
+}
+dump_int(mp->var_used); dump_int(mp->dyn_used);
+mp_print_ln(mp); mp_print_int(mp, x);
+mp_print(mp, " memory locations dumped; current usage is ");
+mp_print_int(mp, mp->var_used); mp_print_char(mp, xord('&')); mp_print_int(mp, mp->dyn_used)
+
+@ @<Undump the dynamic memory@>=
+undump(lo_mem_stat_max+1000,hi_mem_stat_min-1,mp->lo_mem_max);
+undump(lo_mem_stat_max+1,mp->lo_mem_max,mp->rover);
+p=0; q=mp->rover;
+do {
+ for (k=p;k<= q+1; k++)
+ undump_wd(mp->mem[k]);
+ p=q+node_size(q);
+ if ( (p>mp->lo_mem_max)||((q>=rmp_link(q))&&(rmp_link(q)!=mp->rover)) )
+ goto OFF_BASE;
+ q=rmp_link(q);
+} while (q!=mp->rover);
+for (k=p;k<=mp->lo_mem_max;k++ )
+ undump_wd(mp->mem[k]);
+undump(mp->lo_mem_max+1,hi_mem_stat_min,mp->hi_mem_min);
+undump(null,mp->mem_top,mp->avail); mp->mem_end=mp->mem_top;
+mp->last_pending=spec_head;
+for (k=mp->hi_mem_min;k<= mp->mem_end;k++)
+ undump_wd(mp->mem[k]);
+undump_int(mp->var_used); undump_int(mp->dyn_used)
+
+@ A different scheme is used to compress the hash table, since its lower region
+is usually sparse. When |text(p)<>0| for |p<=hash_used|, we output three
+words: |p|, |hash[p]|, and |eqtb[p]|. The hash table is, of course, densely
+packed for |p>=hash_used|, so the remaining entries are output in~a~block.
+
+@<Dump the table of equivalents and the hash table@>=
+dump_int(mp->hash_used);
+mp->st_count=frozen_inaccessible-1-mp->hash_used;
+for (p=1;p<=mp->hash_used;p++) {
+ if ( text(p)!=0 ) {
+ dump_int(p); dump_hh(mp->hash[p]); dump_hh(mp->eqtb[p]); incr(mp->st_count);
+ }
+}
+for (p=mp->hash_used+1;p<=(int)hash_end;p++) {
+ dump_hh(mp->hash[p]); dump_hh(mp->eqtb[p]);
+}
+dump_int(mp->st_count);
+mp_print_ln(mp); mp_print_int(mp, mp->st_count); mp_print(mp, " symbolic tokens")
+
+@ @<Undump the table of equivalents and the hash table@>=
+undump(1,frozen_inaccessible,mp->hash_used);
+p=0;
+do {
+ undump(p+1,mp->hash_used,p);
+ undump_hh(mp->hash[p]); undump_hh(mp->eqtb[p]);
+} while (p!=mp->hash_used);
+for (p=mp->hash_used+1;p<=(int)hash_end;p++ ) {
+ undump_hh(mp->hash[p]); undump_hh(mp->eqtb[p]);
+}
+undump_int(mp->st_count)
+
+@ We have already printed a lot of statistics, so we set |mp_tracing_stats:=0|
+to prevent them appearing again.
+
+@<Dump a few more things and the closing check word@>=
+dump_int(mp->max_internal);
+dump_int(mp->int_ptr);
+for (k=1;k<= mp->int_ptr;k++ ) {
+ dump_int(mp->internal[k]);
+ dump_string(mp->int_name[k]);
+}
+dump_int(mp->start_sym);
+dump_int(mp->interaction);
+dump_string(mp->mem_ident);
+dump_int(mp->bg_loc); dump_int(mp->eg_loc); dump_int(mp->serial_no); dump_int(69073);
+mp->internal[mp_tracing_stats]=0
+
+@ @<Undump a few more things and the closing check word@>=
+undump_int(x);
+if (x>mp->max_internal) mp_grow_internals(mp,x);
+undump_int(mp->int_ptr);
+for (k=1;k<= mp->int_ptr;k++) {
+ undump_int(mp->internal[k]);
+ undump_string(mp->int_name[k]);
+}
+undump(0,frozen_inaccessible,mp->start_sym);
+if (mp->interaction==mp_unspecified_mode) {
+ undump(mp_unspecified_mode,mp_error_stop_mode,mp->interaction);
+} else {
+ undump(mp_unspecified_mode,mp_error_stop_mode,x);
+}
+undump_string(mp->mem_ident);
+undump(1,hash_end,mp->bg_loc);
+undump(1,hash_end,mp->eg_loc);
+undump_int(mp->serial_no);
+undump_int(x);
+if (x!=69073) goto OFF_BASE
+
+@ @<Create the |mem_ident|...@>=
+{
+ char *tmp = mp_xmalloc(mp,11,1);
+ mp_xfree(mp->mem_ident);
+ mp->mem_ident = mp_xmalloc(mp,256,1);
+ mp_snprintf(tmp,11,"%04d.%02d.%02d",
+ (int)mp_round_unscaled(mp, mp->internal[mp_year]),
+ (int)mp_round_unscaled(mp, mp->internal[mp_month]),
+ (int)mp_round_unscaled(mp, mp->internal[mp_day]));
+ mp_snprintf(mp->mem_ident,256," (mem=%s %s)",mp->job_name, tmp);
+ mp_xfree(tmp);
+ mp_pack_job_name(mp, ".mem");
+ while (! mp_w_open_out(mp, &mp->mem_file) )
+ mp_prompt_file_name(mp, "mem file name", ".mem");
+ mp_print_nl(mp, "Beginning to dump on file ");
+@.Beginning to dump...@>
+ mp_print(mp, mp->name_of_file);
+ mp_print_nl(mp, mp->mem_ident);
+}
+
+@ @<Close the mem file@>=
+(mp->close_file)(mp,mp->mem_file)