git.oblomov.eu Git - mplib/blob - src/texk/web2c/mpdir/memio.w

   1 % $Id: psout.w 616 2008-07-09 14:05:55Z taco $
   2 %
   3 % Copyright 2008 Taco Hoekwater.
   4 %
   5 % This program is free software: you can redistribute it and/or modify
   6 % it under the terms of the GNU General Public License as published by
   7 % the Free Software Foundation, either version 2 of the License, or
   8 % (at your option) any later version.
   9 %
  10 % This program is distributed in the hope that it will be useful,
  11 % but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 % MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 % GNU General Public License for more details.
  14 %
  15 % You should have received a copy of the GNU General Public License
  16 % along with this program.  If not, see <http://www.gnu.org/licenses/>.
  17 %
  18 % TeX is a trademark of the American Mathematical Society.
  19 % METAFONT is a trademark of Addison-Wesley Publishing Company.
  20 % PostScript is a trademark of Adobe Systems Incorporated.
  21
  22 % Here is TeX material that gets inserted after \input webmac
  23
  24 \font\tenlogo=logo10 % font used for the METAFONT logo
  25 \def\MP{{\tenlogo META}\-{\tenlogo POST}}
  26 \def\title{MetaPost MEM reading and writing}
  27 \def\topofcontents{\hsize 5.5in
  28   \vglue -30pt plus 1fil minus 1.5in
  29   \def\?##1]{\hbox to 1in{\hfil##1.\ }}
  30   }
  31 \def\botofcontents{\vskip 0pt plus 1fil minus 1.5in}
  32 \pdfoutput=1
  33 \pageno=3
  34
  35 @ As usual, need true and false.
  36
  37 @d true 1
  38 @d false 0
  39 @d null 0 /* the null pointer */
  40 @d incr(A)   (A)=(A)+1 /* increase a variable by unity */
  41 @d decr(A)   (A)=(A)-1 /* decrease a variable by unity */
  42 @d qo(A) (A) /* to read eight bits from a quarterword */
  43 @d qi(A) (quarterword)(A) /* to store eight bits in a quarterword */
  44 @d max_quarterword 0x3FFF /* largest allowable value in a |quarterword| */
  45 @d max_halfword 0xFFFFFFF /* largest allowable value in a |halfword| */
  46 @d max_str_ref 127 /* ``infinite'' number of references */
  47
  48
  49 @c
  50 #include <stdio.h>
  51 #include <stdlib.h>
  52 #include <string.h>
  53 #include "mplib.h"
  54 #include "mpmp.h"
  55
  56 @ @c void mp_store_mem_file (MP mp) {
  57   integer k;  /* all-purpose index */
  58   pointer p,q; /* all-purpose pointers */
  59   integer x; /* something to dump */
  60   four_quarters w; /* four ASCII codes */
  61   memory_word WW;
  62   @<Create the |mem_ident|, open the mem file,
  63     and inform the user that dumping has begun@>;
  64   @<Dump constants for consistency check@>;
  65   @<Dump the string pool@>;
  66   @<Dump the dynamic memory@>;
  67   @<Dump the table of equivalents and the hash table@>;
  68   @<Dump a few more things and the closing check word@>;
  69   @<Close the mem file@>;
  70 }
  71
  72 @ Corresponding to the procedure that dumps a mem file, we also have a function
  73 that reads~one~in. The function returns |false| if the dumped mem is
  74 incompatible with the present \MP\ table sizes, etc.
  75
  76 @d too_small(A) { wake_up_terminal;
  77   wterm_ln("---! Must increase the "); wterm((A));
  78 @.Must increase the x@>
  79   goto OFF_BASE;
  80   }
  81
  82 @c
  83 boolean mp_load_mem_file (MP mp) {
  84   integer k; /* all-purpose index */
  85   pointer p,q; /* all-purpose pointers */
  86   integer x; /* something undumped */
  87   str_number s; /* some temporary string */
  88   four_quarters w; /* four ASCII codes */
  89   memory_word WW;
  90   @<Undump the string pool@>;
  91   @<Undump the dynamic memory@>;
  92   @<Undump the table of equivalents and the hash table@>;
  93   @<Undump a few more things and the closing check word@>;
  94   return true; /* it worked! */
  95 OFF_BASE:
  96   wake_up_terminal;
  97   wterm_ln("(Fatal mem file error; I'm stymied)\n");
  98 @.Fatal mem file error@>
  99    return false;
 100 }
 101
 102 @ Mem files consist of |memory_word| items, and we use the following
 103 macros to dump words of different types:
 104
 105 @d dump_wd(A)   { WW=(A);       (mp->write_binary_file)(mp,mp->mem_file,&WW,sizeof(WW)); }
 106 @d dump_int(A)  { int cint=(A); (mp->write_binary_file)(mp,mp->mem_file,&cint,sizeof(cint)); }
 107 @d dump_hh(A)   { WW.hh=(A);    (mp->write_binary_file)(mp,mp->mem_file,&WW,sizeof(WW)); }
 108 @d dump_qqqq(A) { WW.qqqq=(A);  (mp->write_binary_file)(mp,mp->mem_file,&WW,sizeof(WW)); }
 109 @d dump_string(A) { dump_int((int)(strlen(A)+1));
 110                     (mp->write_binary_file)(mp,mp->mem_file,A,strlen(A)+1); }
 111
 112 @ The inverse macros are slightly more complicated, since we need to check
 113 the range of the values we are reading in. We say `|undump(a)(b)(x)|' to
 114 read an integer value |x| that is supposed to be in the range |a<=x<=b|.
 115
 116 @d mgeti(A) do {
 117   size_t wanted = sizeof(A);
 118   void *A_ptr = &A;
 119   (mp->read_binary_file)(mp, mp->mem_file,&A_ptr,&wanted);
 120   if (wanted!=sizeof(A)) goto OFF_BASE;
 121 } while (0)
 122
 123 @d mgetw(A) do {
 124   size_t wanted = sizeof(A);
 125   void *A_ptr = &A;
 126   (mp->read_binary_file)(mp, mp->mem_file,&A_ptr,&wanted);
 127   if (wanted!=sizeof(A)) goto OFF_BASE;
 128 } while (0)
 129
 130 @d undump_wd(A)   { mgetw(WW); A=WW; }
 131 @d undump_int(A)  { int cint; mgeti(cint); A=cint; }
 132 @d undump_hh(A)   { mgetw(WW); A=WW.hh; }
 133 @d undump_qqqq(A) { mgetw(WW); A=WW.qqqq; }
 134 @d undump_strings(A,B,C) {
 135    undump_int(x); if ( (x<(A)) || (x>(B)) ) goto OFF_BASE; else C=str(x); }
 136 @d undump(A,B,C) { undump_int(x);
 137                    if ( (x<(A)) || (x>(int)(B)) ) goto OFF_BASE; else C=x; }
 138 @d undump_size(A,B,C,D) { undump_int(x);
 139                           if (x<(A)) goto OFF_BASE;
 140                           if (x>(B)) too_small((C)); else D=x; }
 141 @d undump_string(A) {
 142   size_t the_wanted;
 143   void *the_string;
 144   integer XX=0;
 145   undump_int(XX);
 146   the_wanted = (size_t)XX;
 147   the_string = mp_xmalloc(mp,(size_t)XX,1);
 148   (mp->read_binary_file)(mp,mp->mem_file,&the_string,&the_wanted);
 149   A = (char *)the_string;
 150   if (the_wanted!=(size_t)XX) goto OFF_BASE;
 151 }
 152
 153 @ The next few sections of the program should make it clear how we use the
 154 dump/undump macros.
 155
 156 @<Dump constants for consistency check@>=
 157 x = metapost_magic; dump_int(x);
 158 dump_int(mp->mem_top);
 159 dump_int((integer)mp->hash_size);
 160 dump_int(mp->hash_prime)
 161 dump_int(mp->param_size);
 162 dump_int(mp->max_in_open);
 163
 164 @ Sections of a \.{WEB} program that are ``commented out'' still contribute
 165 strings to the string pool; therefore \.{INIMP} and \MP\ will have
 166 the same strings. (And it is, of course, a good thing that they do.)
 167 @.WEB@>
 168 @^string pool@>
 169
 170 @ @c
 171 boolean mp_undump_constants (MP mp) {
 172   integer x;
 173   undump_int(x);
 174   if (x!=metapost_magic) return false;
 175   undump_int(x); mp->mem_top = x;
 176   undump_int(x); mp->hash_size = (unsigned)x;
 177   undump_int(x); mp->hash_prime = x;
 178   undump_int(x); mp->param_size = x;
 179   undump_int(x); mp->max_in_open = x;
 180   return true;
 181   OFF_BASE:
 182     return false;
 183 }
 184
 185 @ We do string pool compaction to avoid dumping unused strings.
 186
 187 @d dump_four_ASCII
 188   w.b0=qi(mp->str_pool[k]); w.b1=qi(mp->str_pool[k+1]);
 189   w.b2=qi(mp->str_pool[k+2]); w.b3=qi(mp->str_pool[k+3]);
 190   dump_qqqq(w)
 191
 192 @<Dump the string pool@>=
 193 mp_do_compaction(mp, mp->pool_size);
 194 dump_int(mp->pool_ptr);
 195 dump_int(mp->max_str_ptr);
 196 dump_int(mp->str_ptr);
 197 k=0;
 198 while ( (mp->next_str[k]==k+1) && (k<=mp->max_str_ptr) )
 199   k++;
 200 dump_int(k);
 201 while ( k<=mp->max_str_ptr ) {
 202   dump_int(mp->next_str[k]); incr(k);
 203 }
 204 k=0;
 205 while (1)  {
 206   dump_int(mp->str_start[k]); /* TODO: valgrind warning here */
 207   if ( k==mp->str_ptr ) {
 208     break;
 209   } else {
 210     k=mp->next_str[k];
 211   }
 212 }
 213 k=0;
 214 while (k+4<mp->pool_ptr ) {
 215   dump_four_ASCII; k=k+4;
 216 }
 217 k=mp->pool_ptr-4; dump_four_ASCII;
 218 mp_print_ln(mp); mp_print(mp, "at most "); mp_print_int(mp, mp->max_str_ptr);
 219 mp_print(mp, " strings of total length ");
 220 mp_print_int(mp, mp->pool_ptr)
 221
 222 @ @d undump_four_ASCII
 223   undump_qqqq(w);
 224   mp->str_pool[k]=(ASCII_code)qo(w.b0); mp->str_pool[k+1]=(ASCII_code)qo(w.b1);
 225   mp->str_pool[k+2]=(ASCII_code)qo(w.b2); mp->str_pool[k+3]=(ASCII_code)qo(w.b3)
 226
 227 @<Undump the string pool@>=
 228 undump_int(mp->pool_ptr);
 229 mp_reallocate_pool(mp, mp->pool_ptr) ;
 230 undump_int(mp->max_str_ptr);
 231 mp_reallocate_strings (mp,mp->max_str_ptr) ;
 232 undump(0,mp->max_str_ptr,mp->str_ptr);
 233 undump(0,mp->max_str_ptr+1,s);
 234 for (k=0;k<=s-1;k++)
 235   mp->next_str[k]=k+1;
 236 for (k=s;k<=mp->max_str_ptr;k++)
 237   undump(s+1,mp->max_str_ptr+1,mp->next_str[k]);
 238 mp->fixed_str_use=0;
 239 k=0;
 240 while (1) {
 241   undump(0,mp->pool_ptr,mp->str_start[k]);
 242   if ( k==mp->str_ptr ) break;
 243   mp->str_ref[k]=max_str_ref;
 244   incr(mp->fixed_str_use);
 245   mp->last_fixed_str=k; k=mp->next_str[k];
 246 }
 247 k=0;
 248 while ( k+4<mp->pool_ptr ) {
 249   undump_four_ASCII; k=k+4;
 250 }
 251 k=mp->pool_ptr-4; undump_four_ASCII;
 252 mp->init_str_use=mp->fixed_str_use; mp->init_pool_ptr=mp->pool_ptr;
 253 mp->max_pool_ptr=mp->pool_ptr;
 254 mp->strs_used_up=mp->fixed_str_use;
 255 mp->pool_in_use=mp->str_start[mp->str_ptr]; mp->strs_in_use=mp->fixed_str_use;
 256 mp->max_pl_used=mp->pool_in_use; mp->max_strs_used=mp->strs_in_use;
 257 mp->pact_count=0; mp->pact_chars=0; mp->pact_strs=0;
 258
 259 @ By sorting the list of available spaces in the variable-size portion of
 260 |mem|, we are usually able to get by without having to dump very much
 261 of the dynamic memory.
 262
 263 We recompute |var_used| and |dyn_used|, so that \.{INIMP} dumps valid
 264 information even when it has not been gathering statistics.
 265
 266 @<Dump the dynamic memory@>=
 267 mp_sort_avail(mp); mp->var_used=0;
 268 dump_int(mp->lo_mem_max); dump_int(mp->rover);
 269 p=0; q=mp->rover; x=0;
 270 do {
 271   for (k=p;k<= q+1;k++)
 272     dump_wd(mp->mem[k]);
 273   x=x+q+2-p; mp->var_used=mp->var_used+q-p;
 274   p=q+node_size(q); q=rmp_link(q);
 275 } while (q!=mp->rover);
 276 mp->var_used=mp->var_used+mp->lo_mem_max-p;
 277 mp->dyn_used=mp->mem_end+1-mp->hi_mem_min;
 278 for (k=p;k<= mp->lo_mem_max;k++ )
 279   dump_wd(mp->mem[k]);
 280 x=x+mp->lo_mem_max+1-p;
 281 dump_int(mp->hi_mem_min); dump_int(mp->avail);
 282 for (k=mp->hi_mem_min;k<=mp->mem_end;k++ )
 283   dump_wd(mp->mem[k]);
 284 x=x+mp->mem_end+1-mp->hi_mem_min;
 285 p=mp->avail;
 286 while ( p!=null ) {
 287   decr(mp->dyn_used); p=mp_link(p);
 288 }
 289 dump_int(mp->var_used); dump_int(mp->dyn_used);
 290 mp_print_ln(mp); mp_print_int(mp, x);
 291 mp_print(mp, " memory locations dumped; current usage is ");
 292 mp_print_int(mp, mp->var_used); mp_print_char(mp, xord('&')); mp_print_int(mp, mp->dyn_used)
 293
 294 @ @<Undump the dynamic memory@>=
 295 undump(lo_mem_stat_max+1000,hi_mem_stat_min-1,mp->lo_mem_max);
 296 undump(lo_mem_stat_max+1,mp->lo_mem_max,mp->rover);
 297 p=0; q=mp->rover;
 298 do {
 299   for (k=p;k<= q+1; k++)
 300     undump_wd(mp->mem[k]);
 301   p=q+node_size(q);
 302   if ( (p>mp->lo_mem_max)||((q>=rmp_link(q))&&(rmp_link(q)!=mp->rover)) )
 303     goto OFF_BASE;
 304   q=rmp_link(q);
 305 } while (q!=mp->rover);
 306 for (k=p;k<=mp->lo_mem_max;k++ )
 307   undump_wd(mp->mem[k]);
 308 undump(mp->lo_mem_max+1,hi_mem_stat_min,mp->hi_mem_min);
 309 undump(null,mp->mem_top,mp->avail); mp->mem_end=mp->mem_top;
 310 mp->last_pending=spec_head;
 311 for (k=mp->hi_mem_min;k<= mp->mem_end;k++)
 312   undump_wd(mp->mem[k]);
 313 undump_int(mp->var_used); undump_int(mp->dyn_used)
 314
 315 @ A different scheme is used to compress the hash table, since its lower region
 316 is usually sparse. When |text(p)<>0| for |p<=hash_used|, we output three
 317 words: |p|, |hash[p]|, and |eqtb[p]|. The hash table is, of course, densely
 318 packed for |p>=hash_used|, so the remaining entries are output in~a~block.
 319
 320 @<Dump the table of equivalents and the hash table@>=
 321 dump_int(mp->hash_used);
 322 mp->st_count=frozen_inaccessible-1-mp->hash_used;
 323 for (p=1;p<=mp->hash_used;p++) {
 324   if ( text(p)!=0 ) {
 325      dump_int(p); dump_hh(mp->hash[p]); dump_hh(mp->eqtb[p]); incr(mp->st_count);
 326   }
 327 }
 328 for (p=mp->hash_used+1;p<=(int)hash_end;p++) {
 329   dump_hh(mp->hash[p]); dump_hh(mp->eqtb[p]);
 330 }
 331 dump_int(mp->st_count);
 332 mp_print_ln(mp); mp_print_int(mp, mp->st_count); mp_print(mp, " symbolic tokens")
 333
 334 @ @<Undump the table of equivalents and the hash table@>=
 335 undump(1,frozen_inaccessible,mp->hash_used);
 336 p=0;
 337 do {
 338   undump(p+1,mp->hash_used,p);
 339   undump_hh(mp->hash[p]); undump_hh(mp->eqtb[p]);
 340 } while (p!=mp->hash_used);
 341 for (p=mp->hash_used+1;p<=(int)hash_end;p++ )  {
 342   undump_hh(mp->hash[p]); undump_hh(mp->eqtb[p]);
 343 }
 344 undump_int(mp->st_count)
 345
 346 @ We have already printed a lot of statistics, so we set |mp_tracing_stats:=0|
 347 to prevent them appearing again.
 348
 349 @<Dump a few more things and the closing check word@>=
 350 dump_int(mp->max_internal);
 351 dump_int(mp->int_ptr);
 352 for (k=1;k<= mp->int_ptr;k++ ) {
 353   dump_int(mp->internal[k]);
 354   dump_string(mp->int_name[k]);
 355 }
 356 dump_int(mp->start_sym);
 357 dump_int(mp->interaction);
 358 dump_string(mp->mem_ident);
 359 dump_int(mp->bg_loc); dump_int(mp->eg_loc); dump_int(mp->serial_no); dump_int(69073);
 360 mp->internal[mp_tracing_stats]=0
 361
 362 @ @<Undump a few more things and the closing check word@>=
 363 undump_int(x);
 364 if (x>mp->max_internal) mp_grow_internals(mp,x);
 365 undump_int(mp->int_ptr);
 366 for (k=1;k<= mp->int_ptr;k++) {
 367   undump_int(mp->internal[k]);
 368   undump_string(mp->int_name[k]);
 369 }
 370 undump(0,frozen_inaccessible,mp->start_sym);
 371 if (mp->interaction==mp_unspecified_mode) {
 372   undump(mp_unspecified_mode,mp_error_stop_mode,mp->interaction);
 373 } else {
 374   undump(mp_unspecified_mode,mp_error_stop_mode,x);
 375 }
 376 undump_string(mp->mem_ident);
 377 undump(1,hash_end,mp->bg_loc);
 378 undump(1,hash_end,mp->eg_loc);
 379 undump_int(mp->serial_no);
 380 undump_int(x);
 381 if (x!=69073) goto OFF_BASE
 382
 383 @ @<Create the |mem_ident|...@>=
 384 {
 385   char *tmp = mp_xmalloc(mp,11,1);
 386   mp_xfree(mp->mem_ident);
 387   mp->mem_ident = mp_xmalloc(mp,256,1);
 388   mp_snprintf(tmp,11,"%04d.%02d.%02d",
 389           (int)mp_round_unscaled(mp, mp->internal[mp_year]),
 390           (int)mp_round_unscaled(mp, mp->internal[mp_month]),
 391           (int)mp_round_unscaled(mp, mp->internal[mp_day]));
 392   mp_snprintf(mp->mem_ident,256," (mem=%s %s)",mp->job_name, tmp);
 393   mp_xfree(tmp);
 394   mp_pack_job_name(mp, ".mem");
 395   while (! mp_w_open_out(mp, &mp->mem_file) )
 396     mp_prompt_file_name(mp, "mem file name", ".mem");
 397   mp_print_nl(mp, "Beginning to dump on file ");
 398 @.Beginning to dump...@>
 399   mp_print(mp, mp->name_of_file);
 400   mp_print_nl(mp, mp->mem_ident);
 401 }
 402
 403 @ @<Close the mem file@>=
 404 (mp->close_file)(mp,mp->mem_file)