*** empty log message ***

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

diff --git a/libguile/print.c b/libguile/print.c
index e92cd78..5b3e35e 100644 (file)
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -1,4 +1,4 @@
-/*     Copyright (C) 1995-1999 Free Software Foundation, Inc.
+/*     Copyright (C) 1995-1999, 2000 Free Software Foundation, Inc.
  * 
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -45,26 +45,26 @@
 \f
 
 #include <stdio.h>
-#include "_scm.h"
-#include "chars.h"
-#include "smob.h"
-#include "eval.h"
-#include "macros.h"
-#include "procprop.h"
-#include "read.h"
-#include "weaks.h"
-#include "unif.h"
-#include "alist.h"
-#include "struct.h"
-#include "objects.h"
-#include "ports.h"
-#include "root.h"
-#include "strings.h"
-#include "strports.h"
-#include "vectors.h"
-
-#include "validate.h"
-#include "print.h"
+#include "libguile/_scm.h"
+#include "libguile/chars.h"
+#include "libguile/smob.h"
+#include "libguile/eval.h"
+#include "libguile/macros.h"
+#include "libguile/procprop.h"
+#include "libguile/read.h"
+#include "libguile/weaks.h"
+#include "libguile/unif.h"
+#include "libguile/alist.h"
+#include "libguile/struct.h"
+#include "libguile/objects.h"
+#include "libguile/ports.h"
+#include "libguile/root.h"
+#include "libguile/strings.h"
+#include "libguile/strports.h"
+#include "libguile/vectors.h"
+
+#include "libguile/validate.h"
+#include "libguile/print.h"
 \f
 
 /* {Names of immediate symbols}
@@ -193,7 +193,10 @@ SCM_DEFINE (scm_current_pstate, "current-pstate", 0, 0, 0,
             "`current-pstate' is only included in GUILE_DEBUG builds.")
 #define FUNC_NAME s_scm_current_pstate
 {
-  return SCM_CADR (print_state_pool);
+  if (SCM_NNULLP (SCM_CDR (print_state_pool)))
+    return SCM_CADR (print_state_pool);
+  else
+    return SCM_BOOL_F;
 }
 #undef FUNC_NAME
 
@@ -349,7 +352,7 @@ taloop:
        {
        case scm_tcs_cons_gloc:
 
-         if (SCM_CDR ((SCM) SCM_STRUCT_VTABLE_DATA (exp)) == (SCM) 0)
+         if (SCM_STRUCT_VTABLE_DATA (exp) [scm_vtable_index_vcell] == 0)
            {
              ENTER_NESTED_DATA (pstate, exp, circref);
              if (SCM_OBJ_CLASS_FLAGS (exp) & SCM_CLASSF_GOOPS)
@@ -398,7 +401,7 @@ taloop:
                name = scm_macro_name (exp);
                if (!SCM_CLOSUREP (SCM_CDR (exp)))
                  {
-                   code = env = 0;
+                   code = env = SCM_UNDEFINED;
                    scm_puts ("#<primitive-", port);
                  }
                else
@@ -407,11 +410,11 @@ taloop:
                    env = SCM_ENV (SCM_CDR (exp));
                    scm_puts ("#<", port);
                  }
-               if (SCM_UNPACK_CAR(exp) & (3L << 16))
+               if (SCM_CELL_WORD_0 (exp) & (3L << 16))
                  scm_puts ("macro", port);
                else
                  scm_puts ("syntax", port);
-               if (SCM_UNPACK_CAR (exp) & (2L << 16))
+               if (SCM_CELL_WORD_0 (exp) & (2L << 16))
                  scm_putc ('!', port);
              }
            else
@@ -427,7 +430,7 @@ taloop:
                scm_putc (' ', port);
                scm_puts (SCM_ROCHARS (name), port);
              }
-           if (code)
+           if (!SCM_UNBNDP (code))
              {
                if (SCM_PRINT_SOURCE_P)
                  {
@@ -957,19 +960,25 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1,
   char *start;
   char *p;
 
-  if (SCM_TRUE_P (destination)) {
-    destination = scm_cur_outp;
-  } else if (SCM_FALSEP (destination)) {
-    fReturnString = 1;
-    destination = scm_mkstrport (SCM_INUM0, 
-                          scm_make_string (SCM_INUM0, SCM_UNDEFINED),
-                          SCM_OPN | SCM_WRTNG,
-                          FUNC_NAME);
-  } else {
-    SCM_VALIDATE_OPORT_VALUE (1,destination);
-  }
-  SCM_VALIDATE_STRING(2,message);
-  SCM_VALIDATE_LIST(3,args);
+  if (SCM_EQ_P (destination, SCM_BOOL_T))
+    {
+      destination = scm_cur_outp;
+    }
+  else if (SCM_FALSEP (destination))
+    {
+      fReturnString = 1;
+      destination = scm_mkstrport (SCM_INUM0, 
+                                  scm_make_string (SCM_INUM0, SCM_UNDEFINED),
+                                  SCM_OPN | SCM_WRTNG,
+                                  FUNC_NAME);
+    }
+  else
+    {
+      SCM_VALIDATE_OPORT_VALUE (1, destination);
+      destination = SCM_COERCE_OUTPORT (destination);
+    }
+  SCM_VALIDATE_STRING (2, message);
+  SCM_VALIDATE_REST_ARGUMENT (args);
 
   start = SCM_ROCHARS (message);
   for (p = start; *p != '\0'; ++p)
@@ -979,9 +988,9 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1,
          continue;
        
        ++p;
-       if (*p == 'A')
+       if (*p == 'A' || *p == 'a')
          writingp = 0;
-       else if (*p == 'S')
+       else if (*p == 'S' || *p == 's')
          writingp = 1;
        else
          continue;
@@ -996,7 +1005,7 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1,
   if (fReturnString)
     answer = scm_strport_to_string (destination);
 
-  return scm_return_first(answer,message);
+  return scm_return_first (answer, message);
 }
 #undef FUNC_NAME
 
@@ -1090,7 +1099,7 @@ SCM_DEFINE (scm_get_print_state, "get-print-state", 1, 0, 0,
 {
   if (SCM_PORT_WITH_PS_P (port))
     return SCM_PORT_WITH_PS_PS (port);
-  if (SCM_OUTPORTP (port))
+  if (SCM_OUTPUT_PORT_P (port))
     return SCM_BOOL_F;
   RETURN_SCM_WTA (1,port);
 }
@@ -1104,9 +1113,7 @@ scm_init_print ()
   SCM vtable, layout, type;
   
   scm_init_opts (scm_print_options, scm_print_opts, SCM_N_PRINT_OPTIONS);
-  vtable = scm_make_vtable_vtable (scm_make_struct_layout (scm_nullstr),
-                                  SCM_INUM0,
-                                  SCM_EOL);
+  vtable = scm_make_vtable_vtable (scm_nullstr, SCM_INUM0, SCM_EOL);
   layout = scm_make_struct_layout (scm_makfrom0str (SCM_PRINT_STATE_LAYOUT));
   type = scm_make_struct (vtable, SCM_INUM0, SCM_LIST1 (layout));
   scm_set_struct_vtable_name_x (type, SCM_CAR (scm_intern0 ("print-state")));
@@ -1119,7 +1126,7 @@ scm_init_print ()
   scm_set_smob_mark (scm_tc16_port_with_ps, scm_markcdr);
   scm_set_smob_print (scm_tc16_port_with_ps, print_port_with_ps);
   
-#include "print.x"
+#include "libguile/print.x"
 }
 
 /*