home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / lifeos2.zip / LIFE-1.02 / SOURCE / TOKEN.C < prev    next >
C/C++ Source or Header  |  1996-07-12  |  31KB  |  1,383 lines
  1. /* Copyright 1991 Digital Equipment Corporation.
  2. ** All Rights Reserved.
  3. *****************************************************************/
  4. /*     $Id: token.c,v 1.4 1995/07/27 19:22:17 duchier Exp $     */
  5.  
  6. #ifndef lint
  7. static char vcid[] = "$Id: token.c,v 1.4 1995/07/27 19:22:17 duchier Exp $";
  8. #endif /* lint */
  9. #ifndef OS2_PORT
  10. #include <pwd.h>
  11.  
  12. #else
  13. #include <stdlib.h>
  14. #endif
  15. #include "extern.h"
  16. #include "trees.h"
  17. #include "types.h"
  18. #include "token.h"
  19. #include "memory.h"
  20. #include "error.h"
  21. #include "parser.h" /* For heap_copy_psi_term */
  22. #include "modules.h"
  23.  
  24.  
  25. long var_occurred;
  26. ptr_node symbol_table;
  27. ptr_psi_term error_psi_term;
  28. long psi_term_line_number;
  29. long trace_input=FALSE;
  30.  
  31. FILE *output_stream;
  32. char *prompt;
  33.  
  34. long stdin_terminal;
  35.  
  36. /* For parsing from a string */
  37. long stringparse;
  38. char *stringinput;
  39.  
  40. /****************************************************************************/
  41.  
  42. /* Abstract Data Type for the Input File State */
  43.  
  44. /* FILE *last_eof_read; */
  45.  
  46. /* Global input file state information */
  47. /* Note: all characters should be stored in longs.  This ensures
  48.    that noncharacters (i.e., EOF) can also be stored. */
  49. FILE *input_stream;
  50. string input_file_name;
  51. long line_count;
  52. long start_of_line;
  53. long saved_char; /*  RM: Jul  7 1993  changed to 'int' */
  54. long old_saved_char;
  55. ptr_psi_term saved_psi_term;
  56. ptr_psi_term old_saved_psi_term;
  57. long eof_flag;
  58.  
  59. /* Psi-term containing global input file state */
  60. ptr_psi_term input_state;
  61.  
  62. /* Psi-term containing stdin file state */
  63. ptr_psi_term stdin_state;
  64.  
  65. /***********************************************/
  66. /* Utilities */
  67. /* All psi-terms created here are on the HEAP. */
  68. /* Many utilities exist in two versions that allocate on the heap */
  69. /* or the stack. */
  70. /* All these routines are NON-backtrackable. */
  71.  
  72.  
  73.  
  74. void TOKEN_ERROR(p)    /*  RM: Feb  1 1993  */
  75.  
  76.      ptr_psi_term p;
  77. {
  78.   if(p->type==error_psi_term->type) {
  79.     Syntaxerrorline("Module violation (%E).\n");
  80.   }
  81. }
  82.  
  83.  
  84.  
  85. /* Clear EOF if necessary for stdin */
  86. void stdin_cleareof()
  87. {
  88.   if (eof_flag && stdin_terminal) {
  89.     clearerr(stdin);
  90.     start_of_line=TRUE;
  91.     saved_psi_term=NULL;
  92.     old_saved_psi_term=NULL;
  93.     saved_char=0;
  94.     old_saved_char=0;
  95.     eof_flag=FALSE;
  96.   }
  97. }
  98.  
  99.  
  100. /* Add an attribute whose value is an integer to a psi-term */
  101. /* that does not yet contains this attribute. */
  102. void heap_add_int_attr(t, attrname, value)
  103. ptr_psi_term t;
  104. char *attrname;
  105. long value;
  106. {
  107.   ptr_psi_term t1;
  108.  
  109.   t1=heap_psi_term(4);
  110.   t1->type=integer;
  111.   t1->value=heap_alloc(sizeof(REAL));
  112.   *(REAL *)t1->value = (REAL) value;
  113.  
  114.   heap_insert(featcmp,heap_copy_string(attrname),&(t->attr_list), t1);
  115. }
  116.  
  117. void stack_add_int_attr(t, attrname, value)
  118. ptr_psi_term t;
  119. char *attrname;
  120. long value;
  121. {
  122.   ptr_psi_term t1;
  123.  
  124.   t1=stack_psi_term(4);
  125.   t1->type=integer;
  126.   t1->value=heap_alloc(sizeof(REAL)); /* 12.5 */
  127.   *(REAL *)t1->value = (REAL) value;
  128.  
  129.   stack_insert(featcmp,heap_copy_string(attrname),&(t->attr_list), t1);
  130. }
  131.  
  132.  
  133. /* Modify an attribute whose value is an integer to a psi-term */
  134. /* that already contains this attribute with another integer value. */
  135. void heap_mod_int_attr(t, attrname, value)
  136. ptr_psi_term t;
  137. char *attrname;
  138. long value;
  139. {
  140.   ptr_node n;
  141.   ptr_psi_term t1;
  142.  
  143.   n=find(featcmp,attrname,t->attr_list);
  144.   t1=(ptr_psi_term)n->data;
  145.   *(REAL *)t1->value = (REAL) value;
  146. }
  147.  
  148. /*
  149. void stack_mod_int_attr(t, attrname, value)
  150. ptr_psi_term t;
  151. char *attrname;
  152. long value;
  153. {
  154.   ptr_node n;
  155.   ptr_psi_term t1;
  156.  
  157.   n=find(featcmp,attrname,t->attr_list);
  158.   t1=(ptr_psi_term)n->data;
  159.   *(REAL *)t1->value = (REAL) value;
  160. }
  161. */
  162.  
  163.  
  164. /* Add an attribute whose value is a string to a psi-term */
  165. /* that does not yet contains this attribute. */
  166. void heap_add_str_attr(t, attrname, str)
  167. ptr_psi_term t;
  168. char *attrname;
  169. char *str;
  170. {
  171.   ptr_psi_term t1;
  172.  
  173.   t1=heap_psi_term(4);
  174.   t1->type=quoted_string;
  175.   t1->value=(GENERIC)heap_copy_string(str);
  176.  
  177.   heap_insert(featcmp,heap_copy_string(attrname),&(t->attr_list), t1);
  178. }
  179.  
  180. void stack_add_str_attr(t, attrname, str)
  181. ptr_psi_term t;
  182. char *attrname;
  183. char *str;
  184. {
  185.   ptr_psi_term t1;
  186.  
  187.   t1=stack_psi_term(4);
  188.   t1->type=quoted_string;
  189.   t1->value=(GENERIC)stack_copy_string(str);
  190.  
  191.   stack_insert(featcmp,heap_copy_string(attrname),&(t->attr_list), t1);
  192. }
  193.  
  194.  
  195. /* Modify an attribute whose value is a string to a psi-term */
  196. /* that already contains this attribute with another integer value. */
  197. void heap_mod_str_attr(t, attrname, str)
  198. ptr_psi_term t;
  199. char *attrname;
  200. char *str;
  201. {
  202.   ptr_node n;
  203.   ptr_psi_term t1;
  204.  
  205.   n=find(featcmp,attrname,t->attr_list);
  206.   t1=(ptr_psi_term)n->data;
  207.   t1->value=(GENERIC)heap_copy_string(str);
  208. }
  209.  
  210. /*
  211. ATTENTION - This should be made backtrackable if used
  212. void stack_mod_str_attr(t, attrname, str)
  213. ptr_psi_term t;
  214. char *attrname;
  215. char *str;
  216. {
  217.   ptr_node n;
  218.   ptr_psi_term t1;
  219.  
  220.   n=find(featcmp,attrname,t->attr_list);
  221.   t1=(ptr_psi_term)n->data;
  222.   t1->value=(GENERIC)stack_copy_string(str);
  223. }
  224. */
  225.  
  226.  
  227. /* Attach a psi-term to another as an attribute. */
  228. void heap_add_psi_attr(t, attrname, g)
  229. ptr_psi_term t;
  230. char *attrname;
  231. ptr_psi_term g;
  232. {
  233.   heap_insert(featcmp,heap_copy_string(attrname),&(t->attr_list), g);
  234. }
  235.  
  236. void stack_add_psi_attr(t, attrname, g)
  237. ptr_psi_term t;
  238. char *attrname;
  239. ptr_psi_term g;
  240. {
  241.   stack_insert(featcmp,heap_copy_string(attrname),&(t->attr_list), g);
  242. }
  243.  
  244. void bk_stack_add_psi_attr(t, attrname, g)
  245. ptr_psi_term t;
  246. char *attrname;
  247. ptr_psi_term g;
  248. {
  249.   bk_stack_insert(featcmp,heap_copy_string(attrname),&(t->attr_list), g);
  250. }
  251.  
  252.  
  253. /* Get the GENERIC value of a psi-term's attribute */
  254. GENERIC get_attr(t, attrname)
  255. ptr_psi_term t;
  256. char *attrname;
  257. {
  258.   ptr_node n=find(featcmp,attrname,t->attr_list);
  259.   return (GENERIC) n->data;
  260. }
  261.  
  262. /* Get the psi-term's STREAM attribute */
  263. FILE *get_stream(t)
  264. ptr_psi_term t;
  265. {
  266.   return (FILE *) ((ptr_psi_term)get_attr(t,STREAM))->value;
  267. }
  268.  
  269. /***********************************************/
  270. /* Main routines for saving & restoring state */
  271.  
  272.  
  273. /* Save global state into an existing file state psi-term t */
  274. void save_state(t)
  275. ptr_psi_term t;
  276. {
  277.   ptr_node n;
  278.   ptr_psi_term t1;
  279.  
  280.   n=find(featcmp,STREAM,t->attr_list);
  281.   t1=(ptr_psi_term)n->data;
  282.   t1->value=(GENERIC)input_stream;
  283.  
  284.   /*  RM: Jan 27 1993
  285.   heap_mod_str_attr(t,CURRENT_MODULE,current_module->module_name);
  286.   */
  287.   
  288.   heap_mod_str_attr(t,INPUT_FILE_NAME,input_file_name);
  289.   heap_mod_int_attr(t,LINE_COUNT,line_count);
  290.   heap_mod_int_attr(t,SAVED_CHAR,saved_char);
  291.   heap_mod_int_attr(t,OLD_SAVED_CHAR,old_saved_char);
  292.  
  293.   t1=saved_psi_term?saved_psi_term:null_psi_term;
  294.   heap_add_psi_attr(t,SAVED_PSI_TERM,t1);
  295.  
  296.   t1=old_saved_psi_term?old_saved_psi_term:null_psi_term;
  297.   heap_add_psi_attr(t,OLD_SAVED_PSI_TERM,t1);
  298.  
  299.   t1=heap_psi_term(4);
  300.   t1->type=(eof_flag?true:false);
  301.   heap_add_psi_attr(t,EOF_FLAG,t1);
  302.  
  303.   t1=heap_psi_term(4);
  304.   t1->type=(start_of_line?true:false);
  305.   heap_add_psi_attr(t,START_OF_LINE,t1);
  306. }
  307.  
  308.  
  309.  
  310. /* Restore global state from an existing file state psi-term t */
  311. void restore_state(t)
  312. ptr_psi_term t;
  313. {
  314.   long i;
  315.   char *str;
  316.  
  317.   
  318.   input_stream = (FILE *) ((ptr_psi_term)get_attr(t,STREAM))->value;
  319.   str = (char*) ((ptr_psi_term)get_attr(t,INPUT_FILE_NAME))->value;
  320.   strcpy(input_file_name,str);
  321.   /* for (i=0;i++;i<=strlen(str)) input_file_name[i]=str[i]; */
  322.   line_count = *(REAL *) ((ptr_psi_term)get_attr(t,LINE_COUNT))->value;
  323.   saved_char = *(REAL *) ((ptr_psi_term)get_attr(t,SAVED_CHAR))->value;
  324.   old_saved_char= *(REAL *)((ptr_psi_term)get_attr(t,OLD_SAVED_CHAR))->value;
  325.  
  326.   saved_psi_term=(ptr_psi_term)get_attr(t,SAVED_PSI_TERM);
  327.   if (saved_psi_term==null_psi_term) saved_psi_term=NULL;
  328.  
  329.   old_saved_psi_term=(ptr_psi_term)get_attr(t,OLD_SAVED_PSI_TERM);
  330.   if (old_saved_psi_term==null_psi_term) old_saved_psi_term=NULL;
  331.  
  332.   eof_flag = ((ptr_psi_term)get_attr(t,EOF_FLAG))->type==true;
  333.   start_of_line = ((ptr_psi_term)get_attr(t,START_OF_LINE))->type==true;
  334.  
  335.   
  336.   /*  RM: Jan 27 1993
  337.       set_current_module(
  338.       find_module(((ptr_psi_term)get_attr(input_state,
  339.       CURRENT_MODULE))->value));
  340.       */
  341. }
  342.  
  343.  
  344. /* Create a new file state psi-term that reflects the current global state */
  345. void new_state(t)
  346. ptr_psi_term *t;
  347. {
  348.   ptr_psi_term t1;
  349.  
  350.   *t=heap_psi_term(4);
  351.   (*t)->type=inputfilesym;
  352.  
  353.   t1=heap_psi_term(4);
  354.   t1->type=stream;
  355.   t1->value=(GENERIC)input_stream;
  356.   heap_add_psi_attr(*t,STREAM,t1);
  357.  
  358.   /*  RM: Jan 27 1993  */
  359.   heap_add_str_attr(*t,CURRENT_MODULE,current_module->module_name);
  360.   
  361.   /*
  362.     printf("Creating new state for file '%s', module '%s'\n",
  363.     input_file_name,
  364.     current_module->module_name);
  365.     */
  366.   
  367.   heap_add_str_attr(*t,INPUT_FILE_NAME,input_file_name);
  368.   heap_add_int_attr(*t,LINE_COUNT,line_count);
  369.   heap_add_int_attr(*t,SAVED_CHAR,saved_char);
  370.   heap_add_int_attr(*t,OLD_SAVED_CHAR,old_saved_char);
  371.  
  372.   t1=saved_psi_term?saved_psi_term:null_psi_term;
  373.   heap_add_psi_attr(*t,SAVED_PSI_TERM,t1);
  374.  
  375.   t1=old_saved_psi_term?old_saved_psi_term:null_psi_term;
  376.   heap_add_psi_attr(*t,OLD_SAVED_PSI_TERM,t1);
  377.  
  378.   t1=heap_psi_term(4);
  379.   t1->type=(eof_flag?true:false);
  380.   heap_add_psi_attr(*t,EOF_FLAG,t1);
  381.  
  382.   t1=heap_psi_term(4);
  383.   t1->type=(start_of_line?true:false);
  384.   heap_add_psi_attr(*t,START_OF_LINE,t1);
  385. }
  386.  
  387.  
  388.  
  389. /****************************************************************************/
  390.  
  391.  
  392. /* Parser/tokenizer state handling */
  393.  
  394. void save_parse_state(pb)
  395. ptr_parse_block pb;
  396. {
  397.    if (pb) {
  398.      pb->lc   = line_count;
  399.      pb->sol  = start_of_line;
  400.      pb->sc   = saved_char;
  401.      pb->osc  = old_saved_char;
  402.      pb->spt  = saved_psi_term;
  403.      pb->ospt = old_saved_psi_term;
  404.      pb->ef   = eof_flag;
  405.    }
  406. }
  407.  
  408.  
  409. void restore_parse_state(pb)
  410. ptr_parse_block pb;
  411. {
  412.    if (pb) {
  413.      line_count         = pb->lc;
  414.      start_of_line      = pb->sol;
  415.      saved_char         = pb->sc;
  416.      old_saved_char     = pb->osc;
  417.      saved_psi_term     = pb->spt;
  418.      old_saved_psi_term = pb->ospt;
  419.      eof_flag           = pb->ef;
  420.    }
  421. }
  422.  
  423.  
  424. /* Initialize the parser/tokenizer state variables. */
  425. void init_parse_state()
  426. {
  427.   line_count=0;
  428.   start_of_line=TRUE;
  429.   saved_char=0;
  430.   old_saved_char=0;
  431.   saved_psi_term=NULL;
  432.   old_saved_psi_term=NULL;
  433.   eof_flag=FALSE;
  434.   stringparse=FALSE;
  435. }
  436.  
  437.  
  438. /****************************************************************************/
  439.  
  440.  
  441. static long inchange, outchange;
  442. static FILE *out;
  443. ptr_psi_term old_state=NULL; /*  RM: Feb 17 1993  */
  444.  
  445.  
  446.  
  447. /******** BEGIN_TERMINAL_IO()
  448.    These two routines must bracket any I/O directed to the terminal.
  449.    This is to avoid mix-ups between terminal and file I/O since the
  450.    program's input and output streams may be different from stdin stdout.
  451.    See the routine what_next_aim(), which uses them to isolate the
  452.    user interface I/O from the program's own I/O.
  453. */
  454. void begin_terminal_io()
  455. {
  456.   inchange = (input_stream!=stdin);
  457.   outchange = (output_stream!=stdout);
  458.  
  459.   if (outchange) {
  460.     out=output_stream;
  461.     output_stream=stdout;
  462.   }
  463.  
  464.   if (inchange) {
  465.     old_state=input_state;
  466.     open_input_file("stdin");
  467.   }
  468. }
  469.  
  470.  
  471.  
  472. /******** END_TERMINAL_IO()
  473.   End of terminal I/O bracketing.
  474. */
  475. void end_terminal_io()
  476. {
  477.   if (inchange) {
  478.     input_state=old_state;
  479.     restore_state(old_state);
  480.     old_state=NULL; /*  RM: Feb 17 1993  */
  481.   }
  482.   if (outchange)
  483.     output_stream=out;
  484. }
  485.  
  486.  
  487.  
  488. /******** EXPAND_FILE_NAME(str)
  489.   Return the expansion of file name STR.
  490.   For the time being all this does is replace '~' by the HOME directory
  491.   if no user is given, or tries to find the user.
  492. */
  493. #ifndef OS2_PORT
  494. char *expand_file_name(s)
  495. char *s;
  496. {
  497.   char *r;
  498.   char *home, *getenv();
  499.   struct passwd *pw;
  500.   /* char *user="eight character name"; 18.5 */
  501.   char userbuf[STRLEN];
  502.   char *user=userbuf;
  503.   char *t1,*t2;
  504.  
  505.   r=s;
  506.   if (s[0]=='~') {
  507.     t1=s+1;
  508.     t2=user;
  509.     while (*t1!=0 && *t1!='/') {
  510.       *t2= *t1;
  511.       *t2++;
  512.       *t1++;
  513.     }
  514.     *t2=0;
  515.     if ((int)strlen(user)>0) {
  516.       pw = getpwnam(user);
  517.       if (pw) {
  518.     user=pw->pw_dir;
  519.     r=(char *)malloc(strlen(user)+strlen(t1)+1);
  520.     sprintf(r,"%s%s",user,t1);
  521.       }
  522.       else
  523.     /* if (warning()) printf("couldn't find user '%s'.\n",user) */;
  524.     }
  525.     else {
  526.       home=getenv("HOME");
  527.       if (home) {
  528.     r=(char *)malloc(strlen(home)+strlen(s)+1);
  529.     sprintf(r,"%s%s",home,s+1);
  530.       }
  531.       else
  532.     /* if (warning()) printf("no HOME directory.\n") */;
  533.     }
  534.   }
  535.  
  536.   /* printf("*** Using file name: '%s'\n",r); */
  537.   
  538.   return r;
  539. }
  540. #else
  541. char *expand_file_name(s)
  542. char *s;
  543. {
  544.   char *r;
  545.   char *home;
  546.   char *pw;
  547.   char userbuf[STRLEN];
  548.   char *user;
  549.   char *t1,*t2;
  550.    r = s;
  551.   if (s[0]=='~') {
  552.     t1=s+1;
  553.     if (user=getenv("LIFEHOME") ) {
  554.         r=(char *)malloc(strlen(user)+strlen(t1)+2);
  555.     sprintf(r,"%s\\%s",user,t1);
  556.         }
  557.       else
  558.         {
  559.         user = OS2_HOME;
  560.     r=(char *)malloc(strlen(user)+strlen(t1)+1);
  561.     sprintf(r,"%s%s",user,t1);
  562.         }
  563.     }
  564.   return r; 
  565. }
  566. #endif
  567. #if 0
  568.  
  569. char *expand_file_name(s)
  570. char *s;
  571. {
  572.   char *r;
  573.   char *home, *getenv();
  574.   /* char *user="eight character name"; 18.5 */
  575.   char userbuf[STRLEN];
  576.   char *user=userbuf;
  577.   char *t1,*t2;
  578.   r=s;
  579.   if (s[0]=='~') {
  580.     t1=s+1;
  581.     t2=user;
  582.     while (*t1!=0 && *t1!='\\') {
  583.       *t2= *t1;
  584.       *t2++;
  585.       *t1++;
  586.     }
  587.     *t2=0;
  588.     if ((int)strlen(user)>0) {
  589.       if (TRUE) {
  590.     user=OS2_HOME;
  591.     r=(char *)malloc(strlen(user)+strlen(t1)+1);
  592.     sprintf(r,"%s%s",user,t1);
  593.       }
  594.       else
  595.     /* if (warning()) printf("couldn't find user '%s'.\n",user) */;
  596.     }
  597.     else {
  598.       home=getenv("HOME");
  599.       if (home) {
  600.     r=(char *)malloc(strlen(home)+strlen(s)+1);
  601.     sprintf(r,"%s%s",home,s+1);
  602.       }
  603.       else
  604.     /* if (warning()) printf("no HOME directory.\n") */;
  605.     }
  606.   }
  607.  
  608.   /* printf("*** Using file name: '%s'\n",r); */
  609.   
  610.   return r;
  611. }
  612. #endif
  613.   
  614. /******** OPEN_INPUT_FILE(file)
  615.   Open the input file specified by the string FILE.  If the file is "stdin",
  616.   restore the stdin state.  Otherwise, open the file and create a new global
  617.   state for it.
  618.   If the file can't be opened, print an error and open "stdin" instead.
  619. */   
  620. long open_input_file(file)
  621. char *file;
  622. {
  623.   long ok=TRUE;
  624.   long stdin_flag;
  625. #ifdef OS2_PORT
  626. char *file2;
  627. #endif
  628.  
  629.   /* Save global input file state */
  630.   if (input_state!=NULL) save_state(input_state);
  631.  
  632. #ifndef OS2_PORT
  633.   file=expand_file_name(file);
  634.   
  635.   if (stdin_flag=(!strcmp(file,"stdin"))) {
  636.     input_stream=stdin;
  637.     noisy=TRUE;
  638.   }
  639.   else {
  640.     input_stream=fopen(file,"r");
  641.     noisy=FALSE;
  642.   }
  643.   
  644.   if (input_stream==NULL) {
  645.     Errorline("file '%s' does not exist.\n",file);
  646.     file="stdin";
  647.     input_stream=stdin;
  648.     noisy=TRUE;
  649.     ok=FALSE;
  650.   }
  651.  
  652.   if (!stdin_flag || stdin_state==NULL) {
  653.     /* Initialize a new global input file state */
  654.     strcpy(input_file_name,file);
  655.     init_parse_state();
  656.     /* Create a new state containing the new global values */
  657.     new_state(&input_state);
  658.     if (stdin_flag) stdin_state=input_state;
  659.   }
  660.   else {
  661.     input_state=stdin_state;
  662.     restore_state(input_state);
  663.   }
  664.  
  665.   return ok;
  666. #else
  667.   file2=expand_file_name(file);
  668.   
  669.   if (stdin_flag=(!strcmp(file2,"stdin"))) {
  670.     input_stream=stdin;
  671.     noisy=TRUE;
  672.   }
  673.   else {
  674.     input_stream=fopen(file2,"r");
  675.     noisy=FALSE;
  676.   }
  677.   
  678.   if (input_stream==NULL) {
  679. #ifdef DJD_DEBUG
  680. printf("missing file == %s\n",file2);
  681. #endif
  682.  
  683.  
  684.     Errorline("file '%s' does not exist.\n",file2);
  685.     file="stdin";
  686.     input_stream=stdin;
  687.     noisy=TRUE;
  688.     ok=FALSE;
  689.   }
  690.  
  691.   if (!stdin_flag || stdin_state==NULL) {
  692.     /* Initialize a new global input file state */
  693.     strcpy(input_file_name,file2);
  694.     init_parse_state();
  695.     /* Create a new state containing the new global values */
  696.     new_state(&input_state);
  697.     if (stdin_flag) stdin_state=input_state;
  698.   }
  699.   else {
  700.     input_state=stdin_state;
  701.     restore_state(input_state);
  702.   }
  703.  
  704.   return ok;
  705. #endif
  706. }
  707.  
  708.  
  709.  
  710. /******** OPEN_OUTPUT_FILE(file)
  711.   Same thing as OPEN_INPUT_FILE, only for output. If FILE="stdout" then
  712.   output_stream=stdout.
  713. */
  714. long open_output_file(file)
  715. string file;
  716. {
  717.   long ok=TRUE;
  718.  
  719.  
  720.   file=expand_file_name(file);
  721.   
  722.   if (!strcmp(file,"stdout"))
  723.     output_stream=stdout;
  724.   else
  725.     if (!strcmp(file,"stderr"))
  726.       output_stream=stderr;
  727.     else
  728.       output_stream=fopen(file,"w");
  729.    
  730.   if (output_stream==NULL) {
  731.     Errorline("file '%s' could not be opened for output.\n",file);
  732.     ok=FALSE;
  733.     output_stream=stdout;
  734.   }
  735.   
  736.   return ok;
  737. }
  738.  
  739.  
  740.  
  741. /******** READ_CHAR
  742.   Return the char read from the input stream, if end of file reached
  743.   then return EOF.
  744.   If stringparse==TRUE then read characters from the input string
  745.   instead of from a file.
  746. */
  747. long read_char()
  748. {
  749.   long c=0;
  750.   
  751.   if (c=saved_char) {
  752.     saved_char=old_saved_char;
  753.     old_saved_char=0;
  754.   }
  755.   else if (stringparse) {
  756.     if (c=(*stringinput))
  757.       stringinput++;
  758.     else
  759.       c=EOF;
  760.   }
  761.   else if (feof(input_stream))
  762.       c=EOF;
  763.   else {
  764.     if (start_of_line) {
  765.       start_of_line=FALSE;
  766.       line_count++;
  767.       if (input_stream==stdin) Infoline("%s",prompt); /* 21.1 */
  768.     }
  769.      
  770.     c=fgetc(input_stream);
  771.     
  772.     if(trace_input)   /*  RM: Jan 13 1993  */
  773.       if(c!=EOF)
  774.     printf("%c",c);
  775.       else
  776.     printf(" <EOF>\n");
  777. #ifdef OS2_PORT
  778. fflush(stdout);
  779. #endif
  780.     if (c==EOLN)
  781.       start_of_line=TRUE;
  782.   }
  783.  
  784.   /* printf("%c\n",c); RM: Jan  5 1993  Just to trace the parser */
  785.   
  786.   return c;
  787. }
  788.  
  789.  
  790.  
  791. /******** PUT_BACK_CHAR
  792.   Put back one character, if there already are 2 saved characters then report
  793.   an error (= bug).
  794. */
  795. void put_back_char(c)
  796. long c;
  797. {
  798.   if (old_saved_char)
  799.     Errorline("in tokenizer, put_back_char three times (last=%d).\n",c);
  800.   old_saved_char=saved_char;
  801.   saved_char=c;
  802. }
  803.  
  804.  
  805. /******** PUT_BACK_TOKEN
  806.   Put back a psi_term, if there already are two saved then report an
  807.   error (= bug).
  808. */
  809. void put_back_token(t)
  810. psi_term t;
  811. {  
  812.   if (old_saved_psi_term!=NULL)
  813.     Errorline("in parser, put_back_token three times (last=%P).\n",t);
  814.   old_saved_psi_term=saved_psi_term;
  815.   saved_psi_term=stack_copy_psi_term(t);
  816. }
  817.  
  818.  
  819.  
  820. /******** PSI_TERM_ERROR
  821.   Print the line number at which the current psi_term started.
  822. */
  823. void psi_term_error()
  824. {
  825.   perr_i("near line %d",psi_term_line_number);
  826.   if (strcmp(input_file_name,"stdin")) {
  827.     perr_s(" in file \042%s\042",input_file_name);
  828.   }
  829.   /* prompt="error>"; 20.8 */
  830.   parse_ok=FALSE;
  831. }
  832.  
  833.  
  834.  
  835. /******** READ_COMMENT
  836.   Read a comment starting with '%' to the end of the line.
  837. */
  838. void read_comment(tok)
  839. ptr_psi_term tok;
  840. {
  841.   long c;
  842.   
  843.   do {
  844.     c=read_char();
  845.   } while (c!=EOF && c!=EOLN);
  846.   
  847.   tok->type=comment;
  848. }
  849.  
  850. void
  851. read_string_error(n)
  852.      int n;
  853. {
  854.   if (stringparse) parse_ok=FALSE;
  855.   else
  856.     switch (n) {
  857.     case 0:
  858.       Syntaxerrorline("end of file reached before end of string (%E).\n");
  859.       break;
  860.     case 1:
  861.       Syntaxerrorline("Hexadecimal digit expected (%E).\n");
  862.       break;
  863.     }
  864. }
  865.  
  866. int
  867. base2int(n)
  868.      int n;
  869. {
  870.   switch (n) {
  871.   case '0': return 0;
  872.   case '1': return 1;
  873.   case '2': return 2;
  874.   case '3': return 3;
  875.   case '4': return 4;
  876.   case '5': return 5;
  877.   case '6': return 6;
  878.   case '7': return 7;
  879.   case '8': return 8;
  880.   case '9': return 9;
  881.   case 'a':
  882.   case 'A': return 10;
  883.   case 'b':
  884.   case 'B': return 11;
  885.   case 'c':
  886.   case 'C': return 12;
  887.   case 'd':
  888.   case 'D': return 13;
  889.   case 'e':
  890.   case 'E': return 14;
  891.   case 'f':
  892.   case 'F': return 15;
  893.   default:
  894.     fprintf(stderr,"base2int('%c'): illegal argument\n",n);
  895.     exit(-1);
  896.   }
  897. }
  898.  
  899. #define isoctal(c) (c=='0'||c=='1'||c=='2'||c=='3'||c=='4'||c=='5'||c=='6'||c=='7')
  900.  
  901. /******** READ_STRING(e)
  902.   Read a string ending with character E, where E=" or '. Transform a double
  903.   occurrence into a single one so that 'ab""cd' is the string 'ab"cd'.
  904. */
  905. void read_string(tok,e)
  906. ptr_psi_term tok;
  907. long e;
  908. {
  909.   long c;
  910.   string str;
  911.   long len=0;
  912.   long store=TRUE;
  913.   long flag=TRUE;
  914.   
  915.   str[len]=0;
  916.   
  917.   do {
  918.     c=read_char();
  919.     if (c==EOF) {
  920.       store=FALSE;
  921.       flag=FALSE;
  922.       read_string_error(0);
  923.     }
  924.     else if (e=='"' && c=='\\') {
  925.       c=read_char();
  926.       if (c==EOF) {
  927.     store=FALSE;
  928.     flag=FALSE;
  929.     put_back_char('\\');
  930.     read_string_error(0);
  931.       }
  932.       else {
  933.     switch (c) {
  934.     case 'a': c='\a'; break;
  935.     case 'b': c='\b'; break;
  936.     case 'f': c='\f'; break;
  937.     case 'n': c='\n'; break;
  938.     case 'r': c='\r'; break;
  939.     case 't': c='\t'; break;
  940.     case 'v': c='\v'; break;
  941.       /* missing \ooo and \xhh */
  942.     case 'x':
  943.       {
  944.         int n;
  945.         c=read_char();
  946.         if (c==EOF) {
  947.           store=flag=FALSE;
  948.           read_string_error(0);
  949.           break;
  950.         }
  951.         else if (!isxdigit(c)) {
  952.           store=flag=FALSE;
  953.           read_string_error(1);
  954.           break;
  955.         }
  956.         else {
  957.           n = base2int(c);
  958.         }
  959.         c=read_char();
  960.         if (isxdigit(c)) n = 16*n+base2int(c);
  961.         else put_back_char(c);
  962.         c=n;
  963.         break;
  964.       }
  965.     default: 
  966.       if (isoctal(c)) {
  967.         int n,i;
  968.         for(i=n=0;i<3&&isoctal(c);i++,c=read_char())
  969.           n = n*8 + base2int(c);
  970.         if (c!=EOF) put_back_char(c);
  971.         c=n;
  972.         break;
  973.       }
  974.       else break;
  975.     }
  976.       }
  977.     }
  978.     else
  979.       if (c==e) {
  980.     c=read_char();
  981.     if (c!=e) {
  982.       store=FALSE;
  983.       flag=FALSE;
  984.       put_back_char(c);
  985.     }
  986.       }
  987.     if (store)
  988.       if (len==STRLEN) {
  989.     Warningline("string too long, extra ignored (%E).\n");
  990.     store=FALSE;
  991.       }
  992.       else {
  993.     str[len++]=c;
  994.     str[len]=0;
  995.       }
  996.   } while(flag);
  997.   
  998.   if (e=='"')
  999.     tok->value=(GENERIC)heap_copy_string(str);
  1000.   else {
  1001.     tok->type=update_symbol(NULL,str); /* Maybe no_module would be better */
  1002.     tok->value=NULL;
  1003.     TOKEN_ERROR(tok);        /*  RM: Feb  1 1993  */
  1004.   }
  1005. }
  1006.  
  1007.  
  1008.  
  1009. /******** SYMBOLIC(character)
  1010.   Tests if character is a symbol (see macro).
  1011. */
  1012. long symbolic(c)
  1013. long c;
  1014. {
  1015.   return SYMBOL(c);
  1016. }
  1017.  
  1018.  
  1019.  
  1020. /******** LEGAL_IN_NAME(character)
  1021.   Tests if character is legal in a name or a variable (see macros).
  1022. */
  1023. long legal_in_name(c)
  1024. long c;
  1025. {
  1026.   return
  1027.     UPPER(c) ||
  1028.       LOWER(c) ||
  1029.     DIGIT(c);
  1030.  
  1031.   /* || c=='\'' RM: Dec 16 1992  */ ;
  1032. }
  1033.  
  1034.  
  1035.  
  1036. /******** READ_NAME(C,F,TYP)
  1037.   Read in the name starting with character C followed by character of whose
  1038.   type function is F. The result is a psi_term of symbol type TYP.
  1039. */
  1040. void read_name(tok,ch,f,typ)
  1041. ptr_psi_term tok;
  1042. long ch;
  1043. long (*f)();
  1044. ptr_definition typ;
  1045. {
  1046.   long c;
  1047.   string str;
  1048.   long len=1;
  1049.   long store=TRUE;
  1050.   long flag=TRUE;
  1051.   ptr_module module=NULL;
  1052.   ptr_node n; /*  RM: Feb  9 1993  */
  1053.  
  1054.   tok->coref=NULL;
  1055.   tok->resid=NULL;
  1056.   tok->attr_list=NULL;
  1057.  
  1058.   str[0]=ch;
  1059.   
  1060.   do {
  1061.     c=read_char();
  1062.     flag=(*f)(c);
  1063.     
  1064.     if(c=='#' &&       /*  RM: Feb  3 1993  */
  1065.        f==legal_in_name &&
  1066.        len>0 &&
  1067.        len<STRLEN &&
  1068.        !module) {
  1069.       str[len]=0;
  1070.       module=create_module(str);
  1071.       len=0;
  1072.       flag=TRUE;
  1073.  
  1074.       /*  RM: Sep 21 1993  */
  1075.       /* Change the type function if required */
  1076.       c=read_char();
  1077.       if SYMBOL(c)
  1078.     f=symbolic;
  1079.       put_back_char(c);
  1080.     }
  1081.     else
  1082.       if (flag) {
  1083.     if (store)
  1084.       if (len==STRLEN) {
  1085.         Warningline("name too long, extra ignored (%E).\n");
  1086.         store=FALSE;
  1087.       }
  1088.       else
  1089.         str[len++]=c;
  1090.       }
  1091.       else
  1092.     put_back_char(c);
  1093.   } while(flag);
  1094.  
  1095.   if(module && len==0) { /*  RM: Feb  3 1993  */
  1096.     strcpy(str,module->module_name);
  1097.     len=strlen(str);
  1098.     put_back_char('#');
  1099.     module=NULL;
  1100.   }
  1101.   
  1102.   str[len]=0;
  1103.   
  1104.   tok->type=typ;
  1105.   
  1106.   if(typ==constant) {
  1107.     /* printf("module=%s\n",module->module_name); */
  1108.     tok->type=update_symbol(module,str); /*  RM: Feb  3 1993  */
  1109.     tok->value=NULL;
  1110.  
  1111.     TOKEN_ERROR(tok); /*  RM: Feb  1 1993  */
  1112.  
  1113.     /* PVR 4.2.94 for correct level incrementing */
  1114.     if (tok->type->type==global) {
  1115.       var_occurred=TRUE;
  1116.     }
  1117.     if (FALSE /*tok->type->type==global && tok->type->global_value*/) {
  1118.       /*  RM: Nov 10 1993  */
  1119.       
  1120.       /* Remove this for Bruno who didn't like it, and doesn't like
  1121.      to use "print_depth" */
  1122.       
  1123.       /*  RM: Feb  9 1993  */
  1124.       /* Add into the variable tree */
  1125.       var_occurred=TRUE;
  1126.       n=find(strcmp,tok->type->keyword->symbol,var_tree);
  1127.       if (n==NULL) {
  1128.     /* The change is always trailed. */
  1129.     bk2_stack_insert(strcmp,
  1130.              tok->type->keyword->symbol,
  1131.              &var_tree,
  1132.              tok->type->global_value);
  1133.       }
  1134.     }
  1135.     
  1136.   }
  1137.   else    
  1138.     tok->value=(GENERIC)heap_copy_string(str);
  1139. }
  1140.  
  1141.  
  1142.  
  1143. /******** READ_NUMBER(c)
  1144.   Read in the number whose first character is c.
  1145.   Accepted syntax: digit+ [ . digit+ ] [ {e|E} {+|-|empty} digit* ]
  1146.   Negative numbers are dealt with in the parser.
  1147. */
  1148. void read_number(tok,c)
  1149. ptr_psi_term tok;
  1150. long c;
  1151. {
  1152.   long c2;
  1153.   REAL f,p;
  1154.   long sgn,pwr,posflag;
  1155.  
  1156.   /* if (sgn=(c=='-')) c=read_char(); */
  1157.  
  1158.   /* tok->type=integer;   RM: Mar  8 1993  */
  1159.  
  1160.   f=0.0;
  1161.   do { f=f*10.0+(c-'0'); c=read_char(); } while (DIGIT(c));
  1162.  
  1163.   if (c=='.') {
  1164.     c2=read_char();
  1165.     if DIGIT(c2) {
  1166.       /* tok->type=real;     RM: Mar  8 1993  */
  1167.       p=10.0;
  1168.       while (DIGIT(c2)) { f=f+(c2-'0')/p; p=p*10.0; c2=read_char(); }
  1169.       put_back_char(c2);
  1170.     }
  1171.     else {
  1172.       put_back_char(c2);
  1173.       put_back_char(c);
  1174.     }
  1175.   }
  1176.   else
  1177.     put_back_char(c);
  1178.  
  1179.   c=read_char();
  1180.   if (c=='e' || c=='E') {
  1181.     c2=read_char();
  1182.     if (c2=='+' || c2=='-' || DIGIT(c2)) {
  1183.       tok->type=real;
  1184.       posflag = (c2=='+' || DIGIT(c2));
  1185.       if (!DIGIT(c2)) c2=read_char();
  1186.       pwr=0;
  1187.       while (DIGIT(c2)) { pwr=pwr*10+(c2-'0'); c2=read_char(); }
  1188.       put_back_char(c2);
  1189.       p=1.0;
  1190.       while (pwr>=100) { pwr-=100; if (posflag) p*=1e100; else p/=1e100; }
  1191.       while (pwr>=10 ) { pwr-=10;  if (posflag) p*=1e10;  else p/=1e10;  }
  1192.       while (pwr>0   ) { pwr-=1;   if (posflag) p*=1e1;   else p/=1e1;   }
  1193.       f*=p;
  1194.     }
  1195.     else {
  1196.       put_back_char(c2);
  1197.       put_back_char(c);
  1198.     }
  1199.   }
  1200.   else
  1201.     put_back_char(c);
  1202.  
  1203.   /* if (sgn) f = -f; */
  1204.   tok->value=heap_alloc(sizeof(REAL)); /* 12.5 */
  1205.   *(REAL *)tok->value=f;
  1206.  
  1207.   /*  RM: Mar  8 1993  */
  1208.   if(f==floor(f))
  1209.     tok->type=integer;
  1210.   else
  1211.     tok->type=real;
  1212. }
  1213.  
  1214.  
  1215.  
  1216. /******** READ_TOKEN
  1217.   Read in one token from the input stream, represented as a psi_term.
  1218.   Return the psi_term 'end_of_file' if that is the case.
  1219. */
  1220.  
  1221. void read_token_main(); /* Forward declaration */
  1222.  
  1223. /* Used in the parser */
  1224. /* Set prompt to the 'partial input' prompt */
  1225. void read_token(tok)
  1226. ptr_psi_term tok;
  1227. { read_token_main(tok, TRUE); }
  1228.  
  1229. /* Used as a built-in */
  1230. /* Prompt is unchanged */
  1231. void read_token_b(tok)
  1232. ptr_psi_term tok;
  1233. { read_token_main(tok, FALSE); }
  1234.  
  1235. void read_token_main(tok, for_parser)
  1236. ptr_psi_term tok;
  1237. long for_parser;
  1238. {
  1239.   long c, c2;
  1240.   ptr_node n;
  1241.   char p[2];
  1242.  
  1243.   if (for_parser && (saved_psi_term!=NULL)) {
  1244.     *tok= *saved_psi_term;
  1245.     saved_psi_term=old_saved_psi_term;
  1246.     old_saved_psi_term=NULL;
  1247.   }
  1248.   else {
  1249.     tok->type=nothing;
  1250.     
  1251.     do {
  1252.       c=read_char();
  1253.     } while(c!=EOF && (c<=32));
  1254.     
  1255.     if (for_parser) psi_term_line_number=line_count;
  1256.     
  1257.     switch(c) {
  1258.     case EOF:
  1259.       tok->type=eof;
  1260.       tok->value=NULL;
  1261.       break;
  1262.     case '%':
  1263.       read_comment(tok);
  1264.       break;
  1265.     case '"':
  1266.       read_string(tok,c);
  1267.       tok->type=quoted_string;
  1268.       break;
  1269.     case 39: /* The quote symbol "'" */
  1270.       read_string(tok,c);
  1271.       break;
  1272.       
  1273.     default:
  1274.       
  1275.       /* Adding this results in problems with terms like (N-1) */
  1276.       /* if (c=='-' && (c2=read_char()) && DIGIT(c2)) {
  1277.         put_back_char(c2);
  1278.         read_number(tok,c);
  1279.       }
  1280.       else */
  1281.  
  1282.       if(c=='.' || c=='?') { /*  RM: Jul  7 1993  */
  1283.     c2=read_char();
  1284.     put_back_char(c2);
  1285.     /*printf("c2=%d\n",c2);*/
  1286.     if(c2<=' ' || c2==EOF) {
  1287.       if(c=='.')
  1288.         tok->type=final_dot;
  1289.       else
  1290.         tok->type=final_question;
  1291.       
  1292.       tok->value=NULL;
  1293.     }
  1294.     else
  1295.       read_name(tok,c,symbolic,constant);
  1296.       }
  1297.       else
  1298.     if DIGIT(c)
  1299.       read_number(tok,c);
  1300.           else
  1301.             if UPPER(c) {
  1302.               read_name(tok,c,legal_in_name,variable);
  1303.             }
  1304.             else
  1305.               if LOWER(c) {
  1306.                 read_name(tok,c,legal_in_name,constant);
  1307.               }
  1308.               else
  1309.                 if SYMBOL(c) {
  1310.                   read_name(tok,c,symbolic,constant);
  1311.                 }
  1312.         else /*  RM: Jul  7 1993  Moved this */
  1313.           if SINGLE(c) {
  1314.             p[0]=c; p[1]=0;
  1315.             tok->type=update_symbol(current_module,p);
  1316.             tok->value=NULL;
  1317.             TOKEN_ERROR(tok); /*  RM: Feb  1 1993  */
  1318.           }
  1319.           else {
  1320.             Errorline("illegal character %d in input (%E).\n",c);
  1321.           }
  1322.     }
  1323.  
  1324.     if (tok->type==variable) {
  1325.       if (tok->value) {
  1326.         /* If the variable read in has name "_", then it becomes 'top' */
  1327.         /* and is no longer a variable whose name must be remembered.  */
  1328.         /* As a result, '@' and '_' are synonyms in the program input. */
  1329.         if (!strcmp((char *)tok->value,"_")) {
  1330.       p[0]='@'; p[1]=0;
  1331.           tok->type=update_symbol(current_module,p);
  1332.           tok->value=NULL;
  1333.       TOKEN_ERROR(tok); /*  RM: Feb  1 1993  */
  1334.         }
  1335.         else {
  1336.           /* Insert into variable tree, create 'top' value if need be. */
  1337.           var_occurred=TRUE;
  1338.           n=find(strcmp,tok->value,var_tree);
  1339.           if (n==NULL) {
  1340.             ptr_psi_term t=stack_psi_term(0);
  1341.             /* The change is always trailed. */
  1342.             bk2_stack_insert(strcmp,tok->value,&var_tree,t); /* 17.8 */
  1343.             tok->coref=t;
  1344.           }
  1345.           else
  1346.           tok->coref=(ptr_psi_term)n->data;
  1347.         }
  1348.       }
  1349.       /* else do nothing */
  1350.     }
  1351.   }
  1352.  
  1353.   if (tok->type==comment)
  1354.     read_token(tok);
  1355.  
  1356.   if (tok->type!=variable)
  1357.     tok->coref=NULL;
  1358.  
  1359.   tok->attr_list=NULL;
  1360.   tok->status=0;
  1361.   tok->flags=FALSE; /* 14.9 */
  1362.   tok->resid=NULL;
  1363.  
  1364.   if (tok->type==cut) /* 12.7 */
  1365.     tok->value=(GENERIC)choice_stack;
  1366.  
  1367.   do {
  1368.     c=read_char();
  1369.     if (c==EOLN) {
  1370.       if (for_parser) put_back_char(c);
  1371.       c=0;
  1372.     }
  1373.     else if (c<0 || c>32) {
  1374.       put_back_char(c);
  1375.       c=0;
  1376.     }
  1377.   } while(c && c!=EOF);
  1378.   
  1379.   if (for_parser) prompt="|    ";
  1380. }
  1381.  
  1382. /****************************************************************************/
  1383.