diff --git a/lib/chibi/repl.module b/lib/chibi/repl.module new file mode 100644 index 00000000..4db9a267 --- /dev/null +++ b/lib/chibi/repl.module @@ -0,0 +1,5 @@ + +(define-module (chibi repl) + (export repl) + (import-immutable (scheme) (chibi process)) + (include "repl.scm")) diff --git a/lib/chibi/repl.scm b/lib/chibi/repl.scm new file mode 100644 index 00000000..307b0253 --- /dev/null +++ b/lib/chibi/repl.scm @@ -0,0 +1,58 @@ + +(define (run-repl module env) + (if module (display module)) + (display "> ") + (flush-output) + (let lp () + (let ((ch (peek-char))) + (cond ((eof-object? ch) + (exit 0)) + ((and (char? ch) (char-whitespace? ch)) + (read-char) + (lp))))) + (cond + ((eq? #\@ (peek-char)) + (read-char) + (let ((sym (read))) + (if (not (symbol? sym)) + (error "repl: invalid @ syntax: @" sym) + (case sym + ((config) + (let ((res (eval (read) *config-env*))) + (cond + ((not (eq? res (if #f #f))) + (write res) + (newline))) + (run-repl module env))) + ((in) + (let ((mod (read))) + (if (or (not mod) (equal? mod '(scheme))) + (run-repl #f (interaction-environment)) + (let ((env (eval `(module-env (load-module ',mod)) + *config-env*))) + (run-repl mod env))))) + (else + (error "repl: unknown @ escape" sym)))))) + (else + (let ((expr (read))) + (cond + ((eof-object? expr) + (exit 0)) + (else + (let ((res (eval expr env))) + (cond + ((not (eq? res (if #f #f))) + (write res) + (newline))) + (run-repl module env)))))))) + +(define (repl) + (set-signal-action! signal/interrupt + (lambda (n info) + (newline) + (run-repl #f (interaction-environment)))) + (current-exception-handler + (lambda (exn) + (print-exception exn (current-error-port)) + (run-repl #f (interaction-environment)))) + (run-repl #f (interaction-environment))) diff --git a/tools/genstubs.scm b/tools/genstubs.scm index 114320b4..77f240fb 100755 --- a/tools/genstubs.scm +++ b/tools/genstubs.scm @@ -213,7 +213,7 @@ (memq type '(signed-char short int long boolean))) (define (unsigned-int-type? type) - (memq type '(unsigned-char unsigned-short unsigned-int unsigned-long + (memq type '(unsigned-char unsigned-short unsigned unsigned-int unsigned-long size_t off_t time_t clock_t dev_t ino_t mode_t nlink_t uid_t gid_t pid_t blksize_t blkcnt_t sigval_t))) @@ -425,6 +425,11 @@ (lambda (expr rename compare) `(define-struct-like ,(cadr expr) type: class ,@(cddr expr))))) +(define-syntax define-c-union + (er-macro-transformer + (lambda (expr rename compare) + `(define-struct-like ,(cadr expr) type: union ,@(cddr expr))))) + (define-syntax define-c-type (er-macro-transformer (lambda (expr rename compare) @@ -439,8 +444,9 @@ (define-syntax define-c-const (er-macro-transformer (lambda (expr rename compare) - (set! *consts* - (cons (cons (parse-type (cadr expr)) (cddr expr)) *consts*))))) + (let ((type (parse-type (cadr expr)))) + (for-each (lambda (x) (set! *consts* (cons (list type x) *consts*))) + (cddr expr)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; C code generation @@ -568,7 +574,7 @@ (if (type-const? type) "const " "") (if struct-type (string-append (symbol->string struct-type) " ") "") (string-replace (base-type-c-name base) #\- " ") - (if type-spec "*" "") + (if struct-type "*" "") (if (type-pointer? type) "*" "")))) (define (check-type arg type) @@ -605,6 +611,7 @@ ((eq? base 'port) "SEXP_IPORT") ((eq? base 'input-port) "SEXP_IPORT") ((eq? base 'output-port) "SEXP_OPORT") + ((void-pointer-type? type) "SEXP_CPOINTER") (else (type-id-name base))))) (define (write-validator arg type) @@ -1112,9 +1119,9 @@ " return SEXP_VOID;\n" "}\n\n")) -(define (write-type-funcs type) - (let ((name (car type)) - (type (cdr type))) +(define (write-type-funcs orig-type) + (let ((name (car orig-type)) + (type (cdr orig-type))) ;; maybe write finalizer (cond ((memq 'finalizer: type) @@ -1139,7 +1146,7 @@ (cat ", sexp arg" i) (lp (cdr ls) (+ i 1)))))) ") {\n" - " struct " (type-name name) " *r;\n" + " " (or (type-struct-type name) "") " " (type-name name) " *r;\n" " sexp_gc_var1(res);\n" " sexp_gc_preserve1(ctx, res);\n" ;; " res = sexp_alloc_tagged(ctx, sexp_sizeof(cpointer) + sizeof(struct " (type-name name) "), " @@ -1149,8 +1156,8 @@ " res = sexp_alloc_tagged(ctx, sexp_sizeof(cpointer), " (type-id-name name) ");\n" - " r = sexp_cpointer_value(res) = malloc(sizeof(struct " - (type-name name) "));\n" + " r = sexp_cpointer_value(res) = malloc(sizeof(" + (or (type-struct-type name) "") " " (type-name name) "));\n" " sexp_freep(res) = 1;\n" (lambda () (let lp ((ls args) (i 0))