home *** CD-ROM | disk | FTP | other *** search
/ APDL Public Domain 1 / APDL_PD1A.iso / program / language / huprolog / Source / C / SAVE < prev    next >
Encoding:
Text File  |  1990-06-10  |  10.3 KB  |  445 lines
  1.  
  2. /***************************************************
  3. ****************************************************
  4. **                                                **
  5. **  HU-Prolog     Portable Interpreter System     **
  6. **                                                **
  7. **  Release 1.62   January  1990                  **
  8. **                                                **
  9. **  Authors:      C.Horn, M.Dziadzka, M.Horn      **
  10. **                                                **
  11. **  (C) 1989      Humboldt-University             **
  12. **                Department of Mathematics       **
  13. **                GDR 1086 Berlin, P.O.Box 1297   **
  14. **                                                **
  15. ****************************************************
  16. ***************************************************/
  17.  
  18. /*
  19. ** save(filename) generates a File which could be used
  20. ** instead of init.c in the synthesis of a new prolog system
  21. */
  22.  
  23. #include "systems.h"
  24. #include "atoms.h"
  25. #include "types.h"
  26. #include "files.h"
  27.  
  28. #if INITFILE
  29. #include <stdio.h>
  30.  
  31. IMPORT string RESTORESTATE;
  32. FILE *inifile;
  33.  
  34. void inierror(char *m)
  35. {
  36.     fprintf( stderr, "\nError in restore while: %s\n", m );
  37.     exit(1);
  38. }
  39.  
  40. #endif
  41.  
  42.  
  43. IMPORT TERM A0;
  44. IMPORT boolean DOTELL();
  45.  
  46. LOCAL int ENCODE_TERM(TERM T)
  47. {
  48.   IMPORT TERM LASTTERM;
  49.   if (T==nil_term || T==0) return 0;
  50. #if POINTEROFFSET
  51.   return ((int)LASTTERM-(int)T)/sizeof(TERMNODE)+1;
  52. #endif
  53. #if WORDOFFSET
  54.   return (int)LASTTERM-(int)T;
  55. #endif
  56. }
  57.  
  58. LOCAL TERM DECODE_TERM(int N)
  59. { IMPORT TERM LASTTERM;
  60.   if (N==0) return nil_term;
  61. #if POINTEROFFSET
  62.   return (TERM)((int)LASTTERM-(N-1)*sizeof(TERMNODE));
  63. #endif
  64. #if WORDOFFSET
  65.    return (TERM)((int)LASTTERM-(N-1));
  66. #endif
  67. }
  68.  
  69. /******************************/
  70. /*                            */
  71. /*  STRINGTAB                 */
  72. /*                            */
  73. /******************************/
  74.  
  75. IMPORT STRING BASESTRING,STRINGHTOP;
  76. IMPORT char st[];
  77. IMPORT int strhtop;
  78.  
  79. LOCAL void SAVE_STRINGTAB(void)
  80. { STRING I; int CH;
  81. #if INITFILE
  82.     ws( "STRINGHTOP " ); wi(STRINGHTOP); ws("\n");
  83.   for (I=BASESTRING;I<=STRINGHTOP;I++) 
  84.     { CH=repchar(I);  ws(" "); wi(CH);if (CH==0) ws("\n"); }
  85. #else
  86.   ws("\nchar st[]=\n{ ");
  87.   for (I=BASESTRING;I<STRINGHTOP;I++) 
  88.     { CH=repchar(I); wi(CH); ws(", "); if (CH==0) ws("\n  "); }
  89.   wi(repchar(STRINGHTOP));ws("\n};\n\n");
  90.   ws("int strhtop="); wi(STRINGHTOP); ws(";\n");
  91. #endif
  92. }
  93.  
  94. #if INITFILE
  95. int strhtop;
  96. #endif
  97.  
  98. LOCAL Init_Stringtab(void)
  99. { int I; STRING S;
  100. #if INITFILE
  101.   if( fscanf( inifile, "STRINGHTOP %d\n", &strhtop ) != 1 )
  102.     inierror( "Reading string header" );
  103.  
  104. #endif
  105.   STRINGHTOP= (STRING)strhtop;
  106.  
  107. #if INITFILE
  108.   for( S=BASESTRING; S<=STRINGHTOP; S++ ) {
  109.     if( fscanf( inifile, " %d", &I ) != 1 )
  110.       inierror( "Reading string" );
  111.     if( I==0 && fscanf( inifile, "\n" ) != 0 )
  112.       inierror( "Reading eoln string" );
  113.     repchar(S)=I;
  114.  
  115.   }
  116. #else
  117.   for(I=0,S=BASESTRING;S<=STRINGHTOP;I++,S++)
  118.     repchar(S)=st[I];
  119. #endif
  120. }
  121.  
  122.  
  123. /******************************/
  124. /*                            */
  125. /*  HASHTAB                   */
  126. /*                            */
  127. /******************************/
  128.  
  129. IMPORT ATOM HASHTAB[]; 
  130. IMPORT int HASH_SIZE;
  131. IMPORT ATOM ht[];
  132.  
  133. LOCAL void SAVE_HASHTAB(void)
  134. { 
  135.   int I;
  136. #if INITFILE
  137.   ws( "HASHTAB\n" );
  138.   for(I=0;I<=HASH_SIZE;I++ ) {
  139.      wi( HASHTAB[I] ); ws( "\n" );
  140.   }
  141. #else
  142.   ws("\nunsigned short ht[]=\n{ ");
  143.   for (I=0;I<HASH_SIZE;) 
  144.   { wi(HASHTAB[I++]); ws(","); if (I%16==0) ws("\n  "); }
  145.   wi(HASHTAB[HASH_SIZE]);
  146.   ws("\n};\n\n");
  147. #endif
  148. }
  149.  
  150. LOCAL Init_Hashtab(void)
  151. { int I;
  152. #if INITFILE
  153.   int hti;
  154.   if( fscanf( inifile, "HASHTAB\n" )  != 0)
  155.     inierror( "Reading hashtab header" );
  156.  
  157.   for( I =0 ; I <= HASH_SIZE; I++ ) {
  158.     if( fscanf( inifile, "%d\n", &hti ) != 1 )
  159.       inierror( "Reading hashtab" );
  160.     HASHTAB[I]=(ATOM)hti;
  161.   }
  162. #else
  163.   for(I=0;I<=HASH_SIZE;I++) HASHTAB[I]=(ATOM)ht[I];
  164. #endif
  165. }
  166.  
  167.  
  168. /******************************/
  169. /*                            */
  170. /*  ATOMTAB                   */
  171. /*                            */
  172. /******************************/
  173.  
  174. IMPORT ATOM BASEATOM,ATOMHTOP,LASTATOM,ATOMSTOP;
  175. IMPORT STRING STRINGSTOP;
  176. IMPORT struct { unsigned short ar,cl,ls,nx,ch,pr,in; } at[];
  177. IMPORT int athtop,lstatm;
  178.  
  179. LOCAL void save_atom(ATOM A)
  180. { 
  181. #if INITFILE
  182.   wi(arity(A)); ws(" "); 
  183.   if (A==MAIN_0) wi(0); else wi(ENCODE_TERM(clause(A))); ws(" "); 
  184.   wi(longstring(A)); ws(" ");
  185.   wi(nextatom(A)); ws(" ");
  186.   wi(chainatom(A)); ws(" ");
  187.   wi(oprec(A)); ws(" ");
  188.   wi(info(A)); ws( "\n" );
  189. #else
  190.   ws("{");
  191.   wi(arity(A)); ws(","); 
  192.   if (A==MAIN_0) wi(0); else wi(ENCODE_TERM(clause(A))); ws(","); 
  193.   wi(longstring(A)); ws(",");
  194.   wi(nextatom(A)); ws(",");
  195.   wi(chainatom(A)); ws(",");
  196.   wi(oprec(A)); ws(",");
  197.   wi(info(A));
  198.   ws("}");
  199. #endif
  200. }
  201.  
  202. LOCAL void SAVE_ATOMTAB(void)
  203. {
  204.   ATOM A;
  205. #if INITFILE
  206.   ws( "ATOMHTOP " ); wi( (int) ATOMHTOP ); ws( " " );
  207.   ws( "LASTATOM " ); wi( (int) LASTATOM ); ws( "\n" );
  208.   for (A=BASEATOM;A<=ATOMHTOP;inc_atom(A))
  209.      save_atom(A);
  210. #else
  211.   ws("struct { unsigned short ar,cl,ls,nx,ch,pr,in; } at[]=\n");
  212.   ws("{ ");
  213.   for (A=BASEATOM;A<ATOMHTOP;inc_atom(A)) { save_atom(A); ws(",\n  "); }
  214.   save_atom(ATOMHTOP); ws("\n");
  215.   ws("};\n\n");
  216.   ws("int athtop="); wi((int)ATOMHTOP); 
  217.   ws(",lstatm="); wi((int)LASTATOM); ws(";\n\n");
  218. #endif
  219. }
  220.        
  221. #if INITFILE
  222. int athtop, lstatm;
  223. #endif
  224.  
  225. LOCAL Init_Atomtab(void)
  226. { 
  227.   ATOM A; int I;
  228. #if INITFILE
  229.   int ar, cl, ls, nx, ch, pr, in;
  230.   if( fscanf( inifile, "ATOMHTOP %d LASTATOM %d\n", &athtop, &lstatm) != 2 )
  231.     inierror( "Reading Atoms header" );
  232. #endif
  233.   ATOMHTOP= (ATOM)athtop;
  234.   LASTATOM= (ATOM)lstatm;
  235.  
  236.   for (A=BASEATOM,I=0;A<=ATOMHTOP;inc_atom(A),I++)
  237.     {
  238. #if INITFILE
  239.       if( fscanf( inifile,
  240.                     "%d %d %d %d %d %d %d\n",
  241.                      &ar, &cl, &ls, &nx, &ch, &pr, &in )  != 7)
  242.         inierror( "Reading atoms" );
  243.       arity(A)=(ARITY_TYPE)ar;
  244.       clause(A)=DECODE_TERM(cl);
  245.       longstring(A)=(STRING)ls;
  246.       nextatom(A)=(ATOM)nx;
  247.       chainatom(A)=(ATOM)ch;
  248.       oprec(A)=(PREC_TYPE)pr;
  249.       info(A)=(INFO_TYPE)in;
  250. #else
  251.       arity(A)=(ARITY_TYPE)at[I].ar;
  252.       clause(A)=DECODE_TERM(at[I].cl);
  253.       longstring(A)=(STRING)at[I].ls;
  254.       nextatom(A)=(ATOM)at[I].nx;
  255.       chainatom(A)=(ATOM)at[I].ch;
  256.       oprec(A)=(PREC_TYPE)at[I].pr;
  257.       info(A)=(INFO_TYPE)at[I].in;
  258. #endif
  259. #if HACKY
  260.       nrofcalls(A)=0;
  261. #endif
  262.     }
  263.   nextatom(ATOMSTOP)=(card)STRINGSTOP;
  264. }
  265.  
  266.  
  267. /******************************/
  268. /*                            */
  269. /*  FREELIST                  */
  270. /*                            */
  271. /******************************/
  272.  
  273. IMPORT TERM freelist[];
  274. IMPORT int fl[];
  275.  
  276. LOCAL void SAVE_FREELIST(void)
  277. { int I; TERM T;
  278. #if INITFILE
  279.   ws( "FREELIST\n" );
  280.   for (I=0;I<=MAXARITY;I++) {
  281.     wi(ENCODE_TERM(freelist[I])); ws( "\n" );
  282.   }
  283. #else
  284.   ws("\nint fl[]=\n{ ");
  285.   for (I=0;I<MAXARITY;) 
  286.   { wi(ENCODE_TERM(freelist[I++])); ws(","); 
  287.     if (I%16==0) ws("\n  "); 
  288.   }
  289.   wi(ENCODE_TERM(freelist[MAXARITY])); 
  290.   ws("\n};\n\n");
  291. #endif
  292. }
  293.  
  294. LOCAL Init_Freelist(void)
  295. { int I; 
  296. #if INITFILE
  297.   int fl;
  298.   if( fscanf( inifile, "FREELIST\n" ) != 0)
  299.     inierror( "Reading Freelist header" );
  300.   for(I=0; I<= MAXARITY; I++ ) {
  301.     if( fscanf( inifile, "%d\n", &fl )  != 1)
  302.       inierror( "Reading Freelist" );
  303.     freelist[I]=DECODE_TERM(fl);
  304.   }
  305. #else   
  306.   for(I=0;I<=MAXARITY;I++) freelist[I]=DECODE_TERM(fl[I]);
  307. #endif
  308. }
  309.  
  310.  
  311. /******************************/
  312. /*                            */
  313. /*  TERMTAB                   */
  314. /*                            */
  315. /******************************/
  316.  
  317. IMPORT TERM HEAPTOP,LASTTERM;
  318. IMPORT CLAUSE IMPG;
  319. IMPORT unsigned short names[];
  320. IMPORT unsigned short sons[];
  321. IMPORT int hptop,ipg;
  322.  
  323. LOCAL void SAVE_TERMTAB(void)
  324. {
  325.   TERM T; int I;
  326. #if INITFILE
  327.   ws( "HEAPTOP " ); wi(ENCODE_TERM(HEAPTOP)); ws( "\n" );
  328.   ws( "IMPG " ); wi(ENCODE_TERM(IMPG)); ws("\n");
  329.   for (T=HEAPTOP;T<=LASTTERM;inc_term(T)) 
  330.     {
  331.       wi(name(T)); ws( " " ); 
  332.       if (name(T)==INTT) wi(ival(T));
  333.       else if (name(T)==SKELT) wi(offset(T));
  334.       else wi(ENCODE_TERM(son(T)));
  335.       ws( "\n" );
  336.     }
  337. #else
  338.   ws("unsigned short names[]=\n");
  339.   ws("{ ");
  340.   for (T=HEAPTOP,I=0;T<LASTTERM;inc_term(T)) 
  341.     { wi(name(T)); ws(", "); if (++I%8==0) ws("\n  ");  }
  342.   wi(name(LASTTERM)); ws("\n};\n\n");
  343.  
  344.   ws("unsigned short sons[]=\n");
  345.   ws("{ ");
  346.   for (T=HEAPTOP,I=0;T<LASTTERM;inc_term(T)) 
  347.     { if (name(T)==INTT) wi(ival(T));
  348.       else if (name(T)==SKELT) wi(offset(T));
  349.       else wi(ENCODE_TERM(son(T))); 
  350.       ws(", "); if (++I%8==0) ws("\n  ");  
  351.     } 
  352.   if (name(LASTTERM)==INTT) wi(ival(LASTTERM));
  353.   else if (name(LASTTERM)==SKELT) wi(offset(LASTTERM));
  354.   else wi(ENCODE_TERM(son(LASTTERM))); 
  355.   ws("\n};\n\n");
  356.  
  357.   ws("hptop="); wi(ENCODE_TERM(HEAPTOP)); 
  358.   ws(",ipg="); wi(ENCODE_TERM(IMPG)); ws(";\n");
  359. #endif
  360. }
  361.  
  362. #if INITFILE
  363. int hptop, ipg;
  364. #endif
  365.  
  366. LOCAL Init_Termtab(void)
  367. { 
  368.   TERM X; int I;
  369. #if INITFILE
  370.   int iname, ison;
  371.   if( fscanf( inifile, "HEAPTOP %d\n", &hptop ) != 1 )
  372.     inierror( "Reading Termtab header 1" );
  373.   if( fscanf( inifile, "IMPG %d\n", &ipg ) != 1)
  374.     inierror( "Reading Termtab header 2" );
  375. #endif
  376.   HEAPTOP = DECODE_TERM(hptop);
  377.   IMPG = DECODE_TERM(ipg);
  378.   for (X=HEAPTOP,I=0;X<=LASTTERM;inc_term(X),I++)
  379.     { 
  380. #if INITFILE
  381.       if( fscanf( inifile, "%d %d\n", &iname, &ison ) != 2)
  382.         inierror( "Reading Termtab" );
  383.       name(X)=(ATOM)iname;
  384.       if (name(X)==INTT) ival(X)=ison;
  385.       else if (name(X)==SKELT) offset(X)=ison;
  386.       else son(X)=DECODE_TERM(ison);
  387. #else
  388.       name(X)=(ATOM)names[I];
  389.       if (name(X)==INTT) ival(X)=sons[I];
  390.       else if (name(X)==SKELT) offset(X)=sons[I];
  391.       else son(X)=DECODE_TERM(sons[I]);
  392. #endif
  393.     }
  394. }
  395.  
  396.  
  397. /******************************/
  398. /*                            */
  399. /*  SAVE / INIT               */
  400. /*                            */
  401. /******************************/
  402.  
  403. GLOBAL boolean DOSAVE(void)
  404. {   
  405.     DOTELL();
  406. #if INITFILE
  407.     SAVE_TERMTAB();
  408.     SAVE_ATOMTAB();
  409.     SAVE_STRINGTAB();
  410.     SAVE_HASHTAB();
  411.     SAVE_FREELIST();
  412. #else
  413.     ws("\n\n\n");
  414.     SAVE_STRINGTAB();
  415.     SAVE_HASHTAB();
  416.     SAVE_ATOMTAB();
  417.     SAVE_FREELIST();
  418.     SAVE_TERMTAB();
  419.     ws("\n\n\n");
  420. #endif
  421.     CloseFile(outputfile);A0=mkatom(USER_0);
  422.     return DOTELL();
  423. }
  424.  
  425.  
  426. GLOBAL InitAll(void)
  427. {
  428. #if INITFILE
  429.   inifile = fopen( RESTORESTATE, "r" );
  430.   if( inifile == NULL )
  431.     inierror( "Opening saved state" );
  432. #endif
  433.   Init_Termtab();
  434.   Init_Atomtab();
  435.   Init_Stringtab();
  436.   Init_Hashtab();
  437.   Init_Freelist();
  438. #if INITFILE
  439.   if( fclose( inifile ) )
  440.     inierror( "Closing saved state" );
  441. #endif
  442. }
  443.  
  444.  
  445.