* ports.c (scm_char_ready_p): bug fix: in SCM_PROC char-ready's

[bpt/guile.git] / libguile / read.c

diff --git a/libguile/read.c b/libguile/read.c
index 2bda934..dc04c34 100644 (file)
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -70,14 +70,10 @@ scm_option scm_read_opts[] = {
 };
 
 SCM_PROC (s_read_options, "read-options-interface", 0, 1, 0, scm_read_options);
-#ifdef __STDC__
-SCM
-scm_read_options (SCM setting)
-#else
+
 SCM
 scm_read_options (setting)
      SCM setting;
-#endif
 {
   SCM ans = scm_options (setting,
                         scm_read_opts,
@@ -89,16 +85,12 @@ scm_read_options (setting)
 }
 
 SCM_PROC (s_read, "read", 0, 3, 0, scm_read);
-#ifdef __STDC__
-SCM 
-scm_read (SCM port, SCM case_insensitive_p, SCM sharp)
-#else
+
 SCM 
 scm_read (port, case_insensitive_p, sharp)
      SCM port;
      SCM case_insensitive_p;
      SCM sharp;
-#endif
 {
   int c;
   SCM tok_buf, copy;
@@ -129,29 +121,21 @@ scm_read (port, case_insensitive_p, sharp)
 }
 
 
-#ifdef __STDC__
-char *
-scm_grow_tok_buf (SCM * tok_buf)
-#else
+
 char *
 scm_grow_tok_buf (tok_buf)
      SCM * tok_buf;
-#endif
 {
   scm_vector_set_length_x (*tok_buf, SCM_MAKINUM (2 * SCM_LENGTH (*tok_buf)));
   return SCM_CHARS (*tok_buf);
 }
 
 
-#ifdef __STDC__
-int 
-scm_flush_ws (SCM port, char *eoferr)
-#else
+
 int 
 scm_flush_ws (port, eoferr)
      SCM port;
      char *eoferr;
-#endif
 {
   register int c;
   while (1)
@@ -184,15 +168,11 @@ scm_flush_ws (port, eoferr)
 }
 
 
-#ifdef __STDC__
-int
-scm_casei_streq (char * s1, char * s2)
-#else
+
 int
 scm_casei_streq (s1, s2)
      char * s1;
      char * s2;
-#endif
 {
   while (*s1 && *s2)
     if (scm_downcase((int)*s1) != scm_downcase((int)*s2))
@@ -209,17 +189,15 @@ scm_casei_streq (s1, s2)
 /* recsexpr is used when recording expressions
  * constructed by read:sharp.
  */
-#ifdef __STDC__
-static SCM
-recsexpr (SCM obj, int line, int column, SCM filename)
-#else
+
+static SCM recsexpr SCM_P ((SCM obj, int line, int column, SCM filename));
+
 static SCM
 recsexpr (obj, line, column, filename)
      SCM obj;
      int line;
      int column;
      SCM filename;
-#endif
 {
   if (SCM_IMP (obj) || SCM_NCONSP(obj))
     return obj;
@@ -235,12 +213,15 @@ recsexpr (obj, line, column, filename)
            copy = scm_cons (recsexpr (SCM_CAR (obj), line, column, filename),
                             SCM_UNDEFINED);
            while (SCM_NIMP (tmp = SCM_CDR (tmp)) && SCM_CONSP (tmp))
-             copy = (SCM_CDR (copy) = scm_cons (recsexpr (SCM_CAR (tmp),
-                                                          line,
-                                                          column,
-                                                          filename),
-                                                SCM_UNDEFINED));
-           SCM_CDR (copy) = tmp;
+             {
+               SCM_SETCDR (copy, scm_cons (recsexpr (SCM_CAR (tmp),
+                                                     line,
+                                                     column,
+                                                     filename),
+                                           SCM_UNDEFINED));
+               copy = SCM_CDR (copy);
+             }
+           SCM_SETCDR (copy, tmp);
          }
        else
          {
@@ -261,11 +242,33 @@ recsexpr (obj, line, column, filename)
   }
 }
 
+
+/* Consume an SCSH-style block comment.  Assume that we've already
+   read the initial `#!', and eat characters until the matching `!#'.  */
+
+static void
+skip_scsh_block_comment (port)
+     SCM port;
+{
+  char last_c = '\0';
+
+  for (;;)
+    {
+      int c = scm_gen_getc (port);
+
+      if (c == EOF)
+       scm_wta (SCM_UNDEFINED,
+                "unterminated `#! ... !#' comment", "read");
+      else if (c == '#' && last_c == '!')
+       return;
+
+      last_c = c;
+    }
+}
+
+
 static char s_list[]="list";
-#ifdef __STDC__
-SCM 
-scm_lreadr (SCM *tok_buf, SCM port, int case_i, SCM sharp, SCM *copy)
-#else
+
 SCM 
 scm_lreadr (tok_buf, port, case_i, sharp, copy)
      SCM *tok_buf;
@@ -273,7 +276,6 @@ scm_lreadr (tok_buf, port, case_i, sharp, copy)
      int case_i;
      SCM sharp;
      SCM *copy;
-#endif
 {
   int c;
   scm_sizet j;
@@ -281,6 +283,7 @@ scm_lreadr (tok_buf, port, case_i, sharp, copy)
 
 tryagain:
   c = scm_flush_ws (port, s_read);
+tryagain_no_flush_ws:
   switch (c)
     {
     case EOF:
@@ -357,6 +360,14 @@ tryagain:
          c = '#';
          goto num;
 
+       case '!':
+         /* start of a shell script.  Parse as a block comment,
+            terminated by !#, just like SCSH.  */
+         skip_scsh_block_comment (port);
+         /* EOF is not an error here */
+         c = scm_flush_ws (port, (char *)NULL);
+         goto tryagain_no_flush_ws;
+
        case '*':
          j = scm_read_token (c, tok_buf, port, case_i, 0);
          p = scm_istr2bve (SCM_CHARS (*tok_buf) + 1, (long) (j - 1));
@@ -408,7 +419,9 @@ tryagain:
              else
                return got;
            }
-       unkshrp:scm_wta ((SCM) SCM_MAKICHR (c), "unknown # object", "");
+       unkshrp:
+         scm_misc_error (s_read, "Unknown # object: %S",
+                         scm_listify (SCM_MAKICHR (c), SCM_UNDEFINED));
        }
 
     case '"':
@@ -519,18 +532,14 @@ tryagain:
 #ifdef _UNICOS
 _Pragma ("noopt");             /* # pragma _CRI noopt */
 #endif
-#ifdef __STDC__
-scm_sizet 
-scm_read_token (int ic, SCM * tok_buf, SCM port, int case_i, int weird)
-#else
+
 scm_sizet 
-scm_read_token (ic, * tok_buf, port, case_i, weird)
+scm_read_token (ic, tok_buf, port, case_i, weird)
      int ic;
      SCM *tok_buf;
      SCM port;
      int case_i;
      int weird;
-#endif
 {
   register scm_sizet j;
   register int c;
@@ -634,22 +643,19 @@ scm_read_token (ic, * tok_buf, port, case_i, weird)
        }
     }
 }
+
 #ifdef _UNICOS
 _Pragma ("opt");               /* # pragma _CRI opt */
 #endif
 
-#ifdef __STDC__
-SCM 
-scm_lreadparen (SCM * tok_buf, SCM port, char *name, int case_i, SCM sharp, SCM *copy)
-#else
 SCM 
-scm_lreadparen (tok_buf, port, name, case_i, sharp, SCM *copy)
+scm_lreadparen (tok_buf, port, name, case_i, sharp, copy)
      SCM *tok_buf;
      SCM port;
      char *name;
      int case_i;
      SCM sharp;
-#endif
+     SCM *copy;
 {
   SCM tmp;
   SCM tl;
@@ -674,18 +680,16 @@ scm_lreadparen (tok_buf, port, name, case_i, sharp, SCM *copy)
       scm_gen_ungetc (c, port);
       if (scm_i_dot == (tmp = scm_lreadr (tok_buf, port, case_i, sharp, copy)))
        {
-         SCM_CDR (tl) = scm_lreadr (tok_buf, port, case_i, sharp, copy);
+         SCM_SETCDR (tl, scm_lreadr (tok_buf, port, case_i, sharp, copy));
          goto closeit;
        }
-      tl = (SCM_CDR (tl) = scm_cons (tmp, SCM_EOL));
+      SCM_SETCDR (tl, scm_cons (tmp, SCM_EOL));
+      tl = SCM_CDR (tl);
     }
   return ans;
 }
 
-#ifdef __STDC__
-SCM 
-scm_lreadrecparen (SCM * tok_buf, SCM port, char *name, int case_i, SCM sharp, SCM *copy)
-#else
+
 SCM 
 scm_lreadrecparen (tok_buf, port, name, case_i, sharp, copy)
      SCM *tok_buf;
@@ -694,12 +698,11 @@ scm_lreadrecparen (tok_buf, port, name, case_i, sharp, copy)
      int case_i;
      SCM sharp;
      SCM *copy;
-#endif
 {
   register int c;
   register SCM tmp;
-  register SCM tl, tl2;
-  SCM ans, ans2;
+  register SCM tl, tl2 = SCM_EOL;
+  SCM ans, ans2 = SCM_EOL;
   /* Need to capture line and column numbers here. */
   int line = SCM_LINUM (port);
   int column = SCM_COL (port) - 1;
@@ -761,16 +764,10 @@ exit:
 \f
 
 
-#ifdef __STDC__
-void
-scm_init_read (void)
-#else
+
 void
 scm_init_read ()
-#endif
 {
-#ifdef READER_EXTENSIONS
   scm_init_opts (scm_read_options, scm_read_opts, SCM_N_READ_OPTIONS);
-#endif
 #include "read.x"
 }