From 02a763007df4545d2601f9661cabf1499b1836e7 Mon Sep 17 00:00:00 2001
From: Alex Shinn <ashinn@users.noreply.github.com>
Date: Sun, 27 Dec 2009 01:17:32 +0900
Subject: [PATCH] moving disasm to (chibi disasm) module

---
 Makefile                          |  3 ++-
 README                            |  5 ++++-
 eval.c                            | 18 ++++++++++--------
 include/chibi/config.h            |  6 ------
 opt/debug.c => lib/chibi/disasm.c | 30 ++++++++++++++++++------------
 lib/chibi/disasm.module           |  4 ++++
 lib/chibi/filesystem.scm          |  2 +-
 opcodes.c                         |  3 ---
 8 files changed, 39 insertions(+), 32 deletions(-)
 rename opt/debug.c => lib/chibi/disasm.c (83%)
 create mode 100644 lib/chibi/disasm.module

diff --git a/Makefile b/Makefile
index 01e3647c..89fce44a 100644
--- a/Makefile
+++ b/Makefile
@@ -83,7 +83,8 @@ all: chibi-scheme$(EXE) libs
 COMPILED_LIBS := lib/srfi/27/rand$(SO) lib/srfi/33/bit$(SO) \
 	lib/srfi/69/hash$(SO) lib/srfi/98/env$(SO) lib/chibi/ast$(SO) \
 	lib/chibi/net$(SO) lib/chibi/filesystem$(SO) lib/chibi/process$(SO) \
-	lib/chibi/time$(SO) lib/chibi/system$(SO) lib/chibi/heap-stats$(SO)
+	lib/chibi/time$(SO) lib/chibi/system$(SO) lib/chibi/heap-stats$(SO) \
+	lib/chibi/disasm$(SO)
 
 libs: $(COMPILED_LIBS)
 
diff --git a/README b/README
index 7c399df0..cfbdc524 100644
--- a/README
+++ b/README
@@ -72,7 +72,10 @@ The essential functions to remember are:
 A minimal module system is provided by default.  Currently you can
 load the following SRFIs with (import (srfi N)):
 
-  1, 2, 6, 8, 9, 11, 16, 26, 69
+  0, 1, 2, 6, 8, 9, 11, 16, 26, 27, 33, 46, 62, 69, 98
+
+although 0, 46 and 62 are built into the default environment so
+there's no need to import them.
 
 LOAD is extended to accept an optional environment argument, like
 EVAL.  You can also LOAD shared libraries in addition to Scheme source
diff --git a/eval.c b/eval.c
index 0c87270d..e5cf340c 100644
--- a/eval.c
+++ b/eval.c
@@ -8,12 +8,16 @@
 
 static int scheme_initialized_p = 0;
 
-#if SEXP_USE_DEBUG
-#include "opt/debug.c"
-#else
-#define print_stack(...)
-#define print_bytecode(...)
-#define sexp_disasm(...)
+#if SEXP_USE_DEBUG_VM
+static void sexp_print_stack (sexp ctx, sexp *stack, int top, int fp, sexp out) {
+  int i;
+  if (! sexp_oport(out)) out = sexp_current_error_port(ctx);
+  for (i=0; i<top; i++) {
+    sexp_printf(ctx, out, "%s %02d: ", ((i==fp) ? "*" : " "), i);
+    sexp_write(ctx, stack[i], out);
+    sexp_printf(ctx, out, "\n");
+  }
+}
 #endif
 
 static sexp analyze (sexp ctx, sexp x);
@@ -227,7 +231,6 @@ static sexp finalize_bytecode (sexp ctx) {
     else
       sexp_bytecode_literals(bc) = sexp_list_to_vector(ctx, sexp_bytecode_literals(bc));
   }
-  /* sexp_disasm(ctx, bc, sexp_current_error_port(ctx)); */
   return bc;
 }
 
@@ -2278,7 +2281,6 @@ static sexp sexp_copy_opcode (sexp ctx, sexp op) {
   return res;
 }
 
-
 sexp sexp_make_opcode (sexp ctx, sexp name, sexp op_class, sexp code,
                        sexp num_args, sexp flags, sexp arg1t, sexp arg2t,
                        sexp invp, sexp data, sexp data2, sexp_proc1 func) {
diff --git a/include/chibi/config.h b/include/chibi/config.h
index 2810b1a3..865b455a 100644
--- a/include/chibi/config.h
+++ b/include/chibi/config.h
@@ -127,12 +127,6 @@
 /*   this enabled. */
 /* #define SEXP_USE_CHECK_STACK 0 */
 
-/* uncomment this to disable debugging utilities */
-/*   By default there's a `disasm' procedure you can use to */
-/*   view the compiled VM instructions of a procedure.  You can */
-/*   disable this if you don't need it. */
-/* #define SEXP_USE_DEBUG 0 */
-
 /* #define SEXP_USE_DEBUG_VM 0 */
 /*   Experts only. */
 /*   For *very* verbose output on every VM operation. */
diff --git a/opt/debug.c b/lib/chibi/disasm.c
similarity index 83%
rename from opt/debug.c
rename to lib/chibi/disasm.c
index 561cd52f..f2a50b7d 100644
--- a/opt/debug.c
+++ b/lib/chibi/disasm.c
@@ -2,6 +2,8 @@
 /*  Copyright (c) 2009 Alex Shinn.  All rights reserved. */
 /*  BSD-style license: http://synthcode.com/license.txt  */
 
+#include "chibi/eval.h"
+
 #define SEXP_DISASM_MAX_DEPTH 8
 #define SEXP_DISASM_PAD_WIDTH 4
 
@@ -33,8 +35,9 @@ static sexp disasm (sexp ctx, sexp bc, sexp out, int depth) {
   } else if (! sexp_bytecodep(bc)) {
     return sexp_type_exception(ctx, "not a procedure", bc);
   }
-  if (! sexp_oportp(out))
-    return SEXP_VOID;
+  if (! sexp_oportp(out)) {
+    return sexp_type_exception(ctx, "not an output-port", out);
+  }
 
   for (i=0; i<(depth*SEXP_DISASM_PAD_WIDTH); i++)
     sexp_write_char(ctx, ' ', out);
@@ -107,15 +110,18 @@ static sexp sexp_disasm (sexp ctx, sexp bc, sexp out) {
   return disasm(ctx, bc, out, 0);
 }
 
-#if SEXP_USE_DEBUG_VM
-static void sexp_print_stack (sexp ctx, sexp *stack, int top, int fp, sexp out) {
-  int i;
-  if (! sexp_oport(out)) out = sexp_current_error_port(ctx);
-  for (i=0; i<top; i++) {
-    sexp_printf(ctx, out, "%s %02d: ", ((i==fp) ? "*" : " "), i);
-    sexp_write(ctx, stack[i], out);
-    sexp_printf(ctx, out, "\n");
-  }
+sexp sexp_init_library (sexp ctx, sexp env) {
+  sexp_gc_var2(op, name);
+  sexp_gc_preserve2(ctx, op, name);
+  name = sexp_c_string(ctx, "disasm", -1);
+  op = sexp_make_opcode(ctx, name, sexp_make_fixnum(SEXP_OPC_FOREIGN),
+                        sexp_make_fixnum(SEXP_OP_FCALL2), SEXP_ONE,
+                        SEXP_THREE, 0, 0, 0, 0, 0, (sexp_proc1)sexp_disasm);
+  name = sexp_intern(ctx, "*current-error-port*");
+  sexp_opcode_data(op) = sexp_env_cell(sexp_context_env(ctx), name);
+  name = sexp_intern(ctx, "disasm");
+  sexp_env_define(ctx, env, name, op);
+  sexp_gc_release2(ctx);
+  return SEXP_VOID;
 }
-#endif
 
diff --git a/lib/chibi/disasm.module b/lib/chibi/disasm.module
new file mode 100644
index 00000000..46c6189c
--- /dev/null
+++ b/lib/chibi/disasm.module
@@ -0,0 +1,4 @@
+
+(define-module (chibi disasm)
+  (export disasm)
+  (include-shared "disasm"))
diff --git a/lib/chibi/filesystem.scm b/lib/chibi/filesystem.scm
index d1fe36ba..27af77e0 100644
--- a/lib/chibi/filesystem.scm
+++ b/lib/chibi/filesystem.scm
@@ -37,4 +37,4 @@
 (define (file-link? x) (S_ISLNK (file-mode x)))
 (define (file-socket? x) (S_ISSOCK (file-mode x)))
 
-(define (file-exists? x) (and (file-status file) #t))
+(define (file-exists? x) (and (file-status x) #t))
diff --git a/opcodes.c b/opcodes.c
index 5b943e6f..a2af3017 100644
--- a/opcodes.c
+++ b/opcodes.c
@@ -136,9 +136,6 @@ _FN2(SEXP_STRING, SEXP_FIXNUM, "make-constructor", 0, sexp_make_constructor),
 _FN3(SEXP_STRING, SEXP_FIXNUM, "make-getter", 0, sexp_make_getter),
 _FN3(SEXP_STRING, SEXP_FIXNUM, "make-setter", 0, sexp_make_setter),
 #endif
-#if SEXP_USE_DEBUG
-_FN2OPTP(SEXP_PROCEDURE, SEXP_OPORT, "disasm", (sexp)"*current-error-port*", sexp_disasm),
-#endif
 #if PLAN9
 #include "opt/plan9-opcodes.c"
 #endif