moving disasm to (chibi disasm) module

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)
 

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

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) {

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. */

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
 

lib/chibi/disasm.module

@@ -0,0 +1,4 @@
+
+(define-module (chibi disasm)
+  (export disasm)
+  (include-shared "disasm"))

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))

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